home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu036.dms / pu036.adf / Cursor.bas < prev    next >
BASIC Source File  |  1990-06-29  |  134KB  |  4,233 lines
  1.  
  2. '
  3. ' Cursor V1.0 - A Basic-Compiler
  4. ' (c) 1990 by Jürgen Forster
  5. '
  6.  
  7.  DEFINT a-z
  8.  
  9. ' In Pass 1 werden alle Variablen gemerkt, Unterprogrammparameter
  10. ' festgestellt, wenn ein Fehler gefunden wird, wird abgebrochen
  11. ' In Pass 2 werden die Länge des Codes und die Labelwerte berechnet
  12. ' Pass 3 kann schließlich den fertigen Code ausgeben
  13.  
  14. ' Z = Zeile, I = Int, L = Long, R = Real, D = Double, T = Text
  15. ' F = Feld von Feldelementen+deren Anzahl, P = Zeiger auf Feld-Info-Struktur
  16. ' kleingeschrieben: Zeiger darauf
  17.  
  18. ' 0: einfache Variable
  19. ' 1: Monadischer Operator
  20. ' 2: Dyadischer Operator
  21. ' 3: Funktion
  22.  
  23. 'Prioritäten
  24. '  1: Funktion
  25. '  2: Potenzierung
  26. '  3: Negation
  27. '  4: Multiplikation/Division
  28. '  5: Ganzzahldivision
  29. '  6: Modulo Arithmetik
  30. '  7: Addition und Subtraktion
  31. '  8: <=>
  32. '  9: NOT
  33. ' 10: AND
  34. ' 11: OR
  35. ' 12: XOR
  36. ' 13: EQV
  37. ' 14: IMP
  38.  
  39. '************************************************************
  40. '*                                                          *
  41. '* Variablen/Konstanten-Definitionen                        *
  42. '*                                                          *
  43. '************************************************************
  44.  
  45. ' Globale Vars
  46.  DIM SHARED Ergebnis,Ergebnis$,SourceLine$,ErrorInThisLine
  47.  DIM SHARED ThisLine,IsDebugUsed,FileName$,Pass,StringBase
  48.  
  49.  DIM SHARED MaxStrings
  50.  MaxStrings = 1000
  51.  DIM SHARED SString$(MaxStrings)
  52.  DIM SHARED NumStrings
  53.  NumStrings = -1
  54.  
  55.  DIM SHARED MaxWords
  56.  MaxWords = 100
  57.  DIM SHARED Word$(MaxWords),WordPos(MaxWords),WordVarFlags(MaxWords)
  58.  DIM SHARED OperatorNum(MaxWords),IsVar(MaxWords)
  59.  
  60.  DIM SHARED VarTEXT,VarINT,VarLONG,VarREAL,VarDOUB,VarCONST
  61.  VarTEXT = 1 : VarINT = 2 : VarLONG = 4 : VarREAL = 8 : VarDOUB = 16
  62.  VarCONST = 128
  63.  DIM SHARED VarTypeMask
  64.  VarTypeMask = VarTEXT OR VarINT OR VarLONG OR VarREAL OR VarDOUB
  65.  
  66.  DIM SHARED MaxLabels,NumLabels
  67.  MaxLabels = 2000
  68.  DIM SHARED Label$(MaxLabels),LabelLine(MaxLabels),LabelOffset&(MaxLabels)
  69.  NumLabels = -1
  70.  
  71.  DIM SHARED SubNumber,SubCounter
  72. ' SubNumber: Nummer des Unterprogramms (0 bedeutet SHARED, 1 Hauptprogramm)
  73.  
  74. ' Defaulteinstellungen fuer Variable ohne Typ
  75.  
  76.  DIM SHARED CharLetter$,CharNumber$,CharTypes$
  77.  CharLetter$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  78.  CharNumber$ = "0123456789"
  79.  CharTypes$ = "$%&!#"
  80.  
  81.  DIM SHARED CharVarBegin$,CharVarMid$
  82.  CharVarBegin$ = "abcdefghijklmnopqrstuvwxyz"+CharLetter$+CharNumber$+".&"
  83.  CharVarMid$ =   "abcdefghijklmnopqrstuvwxyz"+CharLetter$+CharNumber$+"."
  84.  
  85.  DIM SHARED MaxLevel,MaxParameter
  86.  MaxLevel = 30 : MaxParameter = 10
  87.  DIM SHARED Von(MaxLevel),Bis(MaxLevel),NumPars(MaxLevel)
  88.  DIM SHARED FoundOperator(MaxLevel),ReturnType(MaxLevel)
  89.  DIM SHARED OldLevel(MaxLevel),ReadPointer(MaxLevel)
  90.  DIM SHARED VarianteNum(MaxLevel)
  91.  DIM SHARED ParType(MaxLevel,MaxParameter),CallLevel(MaxLevel,MaxParameter)
  92.  
  93.  DIM SHARED TRUE,FALSE
  94.  TRUE = -1 : FALSE = 0
  95.  
  96.  DIM SHARED TypeWHILE,TypeIF,TypeFOR
  97.  TypeWHILE = 1 : TypeIF = 2 : TypeFOR = 3
  98.  
  99. ' Stack fuer FOR/WHILE/IF
  100.  DIM SHARED MaxStack
  101.  MaxStack = 100
  102.  DIM SHARED StackLine(MaxStack),StackType(MaxStack),Stack$(MaxStack,2)
  103. ' Noch ist nichts auf dem Stack
  104.  DIM SHARED StackPointer
  105.  StackPointer = -1
  106.  
  107. ' fuer READ/DATA
  108.  DIM SHARED MaxData,NumData,NumDataPass2
  109.  MaxData = 4000
  110.  DIM SHARED DataStringOffset(MaxData),DataLine(MaxData)
  111. ' Noch keine Datas vorhanden
  112.  NumData = -1 : NumDataPass2 = -1
  113.  
  114. ' Variablen-Speicher
  115.  DIM SHARED MaxVars,NumVars
  116.  MaxVars = 2000
  117.  DIM SHARED VarName$(MaxVars),VarFlags(MaxVars),VarType(MaxVars)
  118.  DIM SHARED VarSubNum(MaxVars),VarOffset(MaxVars)
  119. ' Noch keine Variable gespeichert
  120.  NumVars = -1
  121.  
  122. ' Noch keine Uebersetzungsfehler
  123.  DIM SHARED NumErrors
  124.  NumErrors = 0
  125.  
  126. ' Nummern zum erzeugen von Labels
  127.  DIM SHARED LabelCounter
  128.  
  129. ' Höchstanzahl an Subs
  130.  DIM SHARED MaxSubs,MaxSubPars
  131.  MaxSubs = 40 : MaxSubPars = 20
  132.  DIM SHARED SubSize(MaxSubs,1)
  133. ' SubNummer von SubSize entspricht der von SubName$ und folgenden nicht!
  134.  DIM SHARED SubName$(MaxSubs)
  135.  DIM SHARED NumSubPars(MaxSubs)
  136.  DIM SHARED SubParType(MaxSubs,MaxSubPars)
  137.  DIM SHARED IsSubDef(MaxSubs)
  138.  DIM SHARED ParPos(MaxSubPars)
  139.  DIM SHARED NumSubs
  140.  NumSubs = -1
  141. ' Labels für die SUB-Anweisung
  142.  DIM SHARED LeaveSubLabel$,SkipSubLabel$
  143.  
  144. ' Fuer die DEFTyp-Anweisung
  145.  DIM SHARED CharVarType(ASC("Z")-ASC("A"))
  146.  
  147. ' Position im Hunk / Größe des Hunks
  148.  DIM SHARED HunkOffset&,HunkSize&
  149.  
  150. '************************************************************
  151. '*                                                          *
  152. '* Alle Schluesselwoerter einlesen                          *
  153. '*                                                          *
  154. '************************************************************
  155.  
  156.  DIM SHARED NumKeyWords
  157.  READ NumKeyWords
  158.  DIM SHARED KeyWord$(NumKeyWords)
  159.  FOR a = 0 TO NumKeyWords
  160.    READ KeyWord$(a)
  161.  NEXT a
  162.  
  163.  DATA 199
  164.  DATA "ABS","ALL","AND","APPEND","AREA","AREAFILL","AS","ASC","ATN","BASE","BEEP"
  165.  DATA "BREAK","CALL","CDBL","CHAIN","CHDIR","CHR$","CINT","CIRCLE","CLEAR"
  166.  DATA "CLNG","CLOSE","CLS","COLLISION","COLOR","COMMON","CONT","COS","CSNG"
  167.  DATA "CSRLIN","CVD","CVI","CVL","CVS","DATA","DATE$","DECLARE","DEF"
  168.  DATA "DEFDBL","DEFINT","DEFLNG","DEFSNG","DEFSTR","DELETE","DIM","EDIT"
  169.  DATA "ELSE","ELSEIF","END","EOF","EQV","ERASE","ERL","ERR","ERROR","EXIT","EXP"
  170.  DATA "FIELD","FILES","FIX","FN","FOR","FRE","FUNCTION","GET","GOSUB"
  171.  DATA "GOTO","HEX$","IF","IMP","INKEY$","INPUT","INPUT$","INSTR","INT"
  172.  DATA "KILL","LBOUND","LEFT$","LEN","LET","LIBRARY","LINE","LIST","LLIST"
  173.  DATA "LOAD","LOC","LOCATE","LOF","LOG","LPOS","LPRINT","LSET","MENU"
  174.  DATA "MERGE","MID$","MKD$","MKI$","MKL$","MKS$","MOD","MOUSE","NAME"
  175.  DATA "NEW","NEXT","NOT","OBJECT.AX","OBJECT.AY","OBJECT.CLIP"
  176.  DATA "OBJECT.CLOSE","OBJECT.HIT","OBJECT.OFF","OBJECT.ON","OBJECT.PLANES"
  177.  DATA "OBJECT.PRIORITY","OBJECT.SHAPE","OBJECT.START","OBJECT.STOP"
  178.  DATA "OBJECT.VX.OBJECT.VY","OBJECT.X","OBJEXT.Y","OCT$","OFF","ON","OPEN"
  179.  DATA "OPTION","OR","OUTPUT","PAINT","PALETTE","PATTERN","PEEK","PEEKL"
  180.  DATA "PEEKW","POINT","POKE","POKEL","POKEW","POS","PRESET","PRINT","PSET"
  181.  DATA "PTAB","PUT","RANDOMIZE","READ","REM","RESET","RESTORE","RESUME","RETURN"
  182.  DATA "RIGHT$","RND","RSET","RUN","SADD","SAVE","SAY","SCREEN","SCROLL"
  183.  DATA "SGN","SHARED","SIN","SLEEP","SOUND","SPACE$","SPC","SQR","STATIC","STEP"
  184.  DATA "STICK","STOP","STR$","STRIG","STRING$","SUB","SWAP","SYSTEM","TAB"
  185.  DATA "TAN","THEN","TIME$","TIMER","TO","TRANSLATE$","TROFF","TRON"
  186.  DATA "UBOUND","UCASE$","USING","USR","VAL","VARPTR","WAIT","WAVE"
  187.  DATA "WEND","WHILE","WIDTH","WINDOW","WRITE","XOR"
  188.  
  189. '************************************************************
  190. '*                                                          *
  191. '* Definition aller System-Funktionen                       *
  192. '*                                                          *
  193. '************************************************************
  194.  
  195.  DIM SHARED NumFuncs
  196.  READ NumFuncs
  197.  DIM SHARED Func$(NumFuncs),FuncType(NumFuncs),FuncHierachie(NumFuncs)
  198.  DIM SHARED NumVarianten(NumFuncs)
  199.  DIM SHARED MaxVarianten
  200.  MaxVarianten = 4
  201.  DIM SHARED NumParameter(NumFuncs,MaxVarianten)
  202.  DIM SHARED VariantenOffset(NumFuncs,MaxVarianten)
  203.  DIM SHARED ResultType(NumFuncs,MaxVarianten)
  204.  MaxParameter = 5
  205.  DIM SHARED Possible(NumFuncs,MaxVarianten,MaxParameter)
  206.  DIM SHARED MakeTo(NumFuncs,MaxVarianten,MaxParameter)
  207.  FOR a = 0 TO NumFuncs
  208.    READ Func$(a),FuncType(a),FuncHierachie(a),NumVarianten(a)
  209.    FOR b = 0 TO NumVarianten(a)
  210.      READ NumParameter(a,b)
  211.      FOR c = 0 TO NumParameter(a,b)
  212.        READ Possible(a,b,c),MakeTo(a,b,c)
  213.      NEXT c
  214.      READ VariantenOffset(a,b),ResultType(a,b)
  215.    NEXT b
  216.  NEXT a
  217.  
  218.  DATA 89
  219.  
  220.  DATA "*",2,4,3
  221.  DATA 1, 2, 2, 2, 2,-1290, 4 :'MUL_II_L
  222.  DATA 1, 6, 4, 6, 4,-1296, 4 :'MUL_LL_L
  223.  DATA 1,14, 8,14, 8,-1302, 8 :'MUL_RR_R
  224.  DATA 1,30,16,30,16,-1284,16 :'MUL_DD_D
  225.  
  226.  DATA "+",2,7,4
  227.  DATA 1, 1, 1, 1, 1,-90, 1 :'ADD_TT_T
  228.  DATA 1, 2, 2, 2, 2,-72, 2 :'ADD_II_I
  229.  DATA 1, 6, 4, 6, 4,-78, 4 :'ADD_LL_L
  230.  DATA 1,14, 8,14, 8,-84, 8 :'ADD_RR_R
  231.  DATA 1,30,16,30,16,-66,16 :'ADD_DD_D
  232.  
  233.  DATA "++",1,3,3
  234.  DATA 0, 2, 2,0, 2 :'NOTHING__
  235.  DATA 0, 4, 4,0, 4 :'NOTHING__
  236.  DATA 0, 8, 8,0, 8 :'NOTHING__
  237.  DATA 0,16,16,0,16 :'NOTHING__
  238.  
  239.  DATA "-",2,7,3
  240.  DATA 1, 2, 2, 2, 2,-2112, 2 :'SUB_II_I
  241.  DATA 1, 6, 4, 6, 4,-2118, 4 :'SUB_LL_L
  242.  DATA 1,14, 8,14, 8,-2124, 8 :'SUB_RR_R
  243.  DATA 1,30,16,30,16,-2100,16 :'SUB_DD_D
  244.  
  245.  DATA "--",1,3,3
  246.  DATA 0, 2, 2,-1320, 2 :'NEG_I_I
  247.  DATA 0, 4, 4,-1326, 4 :'NEG_L_L
  248.  DATA 0, 8, 8,-1332, 8 :'NEG_R_R
  249.  DATA 0,16,16,-1314,16 :'NEG_D_D
  250.  
  251.  DATA "/",2,4,1
  252.  DATA 1,14, 8,14, 8,-474, 8 :'DIV_RR_R
  253.  DATA 1,30,16,30,16,-456,16 :'DIV_DD_D
  254.  
  255.  DATA "<",2,8,4
  256.  DATA 1, 1, 1, 1, 1,-1164, 2 :'LT_TT_I
  257.  DATA 1, 2, 2, 2, 2,-1146, 2 :'LT_II_I
  258.  DATA 1, 6, 4, 6, 4,-1152, 2 :'LT_LL_I
  259.  DATA 1,14, 8,14, 8,-1158, 2 :'LT_RR_R
  260.  DATA 1,30,16,30,16,-1140, 2 :'LT_DD_D
  261.  
  262.  DATA "<=",2,8,4
  263.  DATA 1, 1, 1, 1, 1,-1014, 2 :'LE_TT_I
  264.  DATA 1, 2, 2, 2, 2,-996, 2 :'LE_II_I
  265.  DATA 1, 6, 4, 6, 4,-1002, 2 :'LE_LL_I
  266.  DATA 1,14, 8,14, 8,-1008, 2 :'LE_RR_R
  267.  DATA 1,30,16,30,16,-990, 2 :'LE_DD_D
  268.  
  269.  DATA "<>",2,8,4
  270.  DATA 1, 1, 1, 1, 1,-1386, 2 :'NE_TT_I
  271.  DATA 1, 2, 2, 2, 2,-1368, 2 :'NE_II_I
  272.  DATA 1, 6, 4, 6, 4,-1374, 2 :'NE_LL_I
  273.  DATA 1,14, 8,14, 8,-1380, 2 :'NE_RR_R
  274.  DATA 1,30,16,30,16,-1362, 2 :'NE_DD_D
  275.  
  276.  DATA "=",2,8,4
  277.  DATA 1, 1, 1, 1, 1,-558, 2 :'EQ_TT_I
  278.  DATA 1, 2, 2, 2, 2,-540, 2 :'EQ_II_I
  279.  DATA 1, 6, 4, 6, 4,-546, 2 :'EQ_LL_I
  280.  DATA 1,14, 8,14, 8,-552, 2 :'EQ_RR_R
  281.  DATA 1,30,16,30,16,-534, 2 :'EQ_DD_D
  282.  
  283.  DATA "=>",2,8,4
  284.  DATA 1, 1, 1, 1, 1,-822, 2 :'GE_TT_I
  285.  DATA 1, 2, 2, 2, 2,-804, 2 :'GE_II_I
  286.  DATA 1, 6, 4, 6, 4,-810, 2 :'GE_LL_I
  287.  DATA 1,14, 8,14, 8,-816, 2 :'GE_RR_R
  288.  DATA 1,30,16,30,16,-798, 2 :'GE_DD_D
  289.  
  290.  DATA ">",2,8,4
  291.  DATA 1, 1, 1, 1, 1,-870, 2 :'GT_TT_I
  292.  DATA 1, 2, 2, 2, 2,-852, 2 :'GT_II_I
  293.  DATA 1, 6, 4, 6, 4,-858, 2 :'GT_LL_I
  294.  DATA 1,14, 8,14, 8,-864, 2 :'GT_RR_R
  295.  DATA 1,30,16,30,16,-846, 2 :'GT_DD_D
  296.  
  297.  DATA "ABS",3,1,3
  298.  DATA 0, 2, 2,-48, 2 :'ABS_I_I
  299.  DATA 0, 4, 4,-54, 4 :'ABS_L_L
  300.  DATA 0, 8, 8,-60, 8 :'ABS_R_R
  301.  DATA 0,16,16,-42,16 :'ABS_D_D
  302.  
  303.  DATA "AND",2,10,1
  304.  DATA 1, 2, 2, 2, 2,-96, 2 :'AND_II_I
  305.  DATA 1,30, 4,30, 4,-102, 4 :'AND_LL_L
  306.  
  307.  DATA "ASC",3,1,0
  308.  DATA 0, 1, 1,-126, 2 :'ASC_T_I
  309.  
  310.  DATA "ATN",3,1,1
  311.  DATA 0,14, 8,-138, 8 :'ATN_R_R
  312.  DATA 0,16,16,-132,16 :'ATN_D_D
  313.  
  314.  DATA "CDBL",3,1,0
  315.  DATA 0,30,16,0,16 :'NOTHING__
  316.  
  317.  DATA "CHR$",3,1,0
  318.  DATA 0,30, 2,-186, 1 :'CHR_I_T
  319.  
  320.  DATA "CINT",3,1,0
  321.  DATA 0,30, 2,0, 2 :'NOTHING__
  322.  
  323.  DATA "CLNG",3,1,0
  324.  DATA 0,30, 4,0, 4 :'NOTHING__
  325.  
  326.  DATA "COLLISION",3,1,0
  327.  DATA 0,30, 2,-258, 2 :'COLLISION_I_I
  328.  
  329.  DATA "COS",3,1,1
  330.  DATA 0,14, 8,-354, 8 :'COS_R_R
  331.  DATA 0,16,16,-348,16 :'COS_D_D
  332.  
  333.  DATA "CSNG",3,1,0
  334.  DATA 0,30, 8,0, 8 :'NOTHING__
  335.  
  336.  DATA "CSRLIN",3,1,0
  337.  DATA -1,-360, 2 :'CSRLIN__I
  338.  
  339.  DATA "CVD",3,1,0
  340.  DATA 0, 1, 1,-366,16 :'CVD_T_D
  341.  
  342.  DATA "CVI",3,1,0
  343.  DATA 0, 1, 1,-372, 2 :'CVI_T_I
  344.  
  345.  DATA "CVL",3,1,0
  346.  DATA 0, 1, 1,-378, 4 :'CVL_T_L
  347.  
  348.  DATA "CVS",3,1,0
  349.  DATA 0, 1, 1,-384, 8 :'CVL_T_R
  350.  
  351.  DATA "DATE$",3,1,0
  352.  DATA -1,-390, 1 :'DATE__T
  353.  
  354.  DATA "EOF",3,1,0
  355.  DATA 0,30, 2,-516, 2 :'EOF_I_I
  356.  
  357.  DATA "EQV",2,13,1
  358.  DATA 1, 2, 2, 2, 2,-522, 2 :'EQV_II_I
  359.  DATA 1,30, 4,30, 4,-528, 4 :'EQV_LL_L
  360.  
  361.  DATA "ERL",3,1,0
  362.  DATA -1,-570, 2 :'ERL__I
  363.  
  364.  DATA "ERR",3,1,0
  365.  DATA -1,-582, 2 :'ERR__I
  366.  
  367.  DATA "EXP",3,1,1
  368.  DATA 0,14, 8,-594, 8 :'EXP_R_R
  369.  DATA 0,16,16,-588,16 :'EXP_D_D
  370.  
  371.  DATA "FIX",3,1,3
  372.  DATA 0, 2, 2,0, 2 :'NOTHING__
  373.  DATA 0, 4, 4,0, 4 :'NOTHING__
  374.  DATA 0, 8, 8,-672, 8 :'FIX_R_R
  375.  DATA 0,16,16,-666,16 :'FIX_D_D
  376.  
  377.  DATA "FRE",3,1,0
  378.  DATA 0,30, 2,-708, 4 :'FRE_I_L
  379.  
  380.  DATA "HEX$",3,1,0
  381.  DATA 0,30, 4,-876, 1 :'HEX_L_T
  382.  
  383.  DATA "IF",3,1,4
  384.  DATA 2,30, 2, 1, 1, 1, 1,-906, 1 :'IF_ITT_T
  385.  DATA 2,30, 2, 2, 2, 2, 2,-888, 2 :'IF_III_I
  386.  DATA 2,30, 2, 6, 4, 6, 4,-894, 4 :'IF_ILL_L
  387.  DATA 2,30, 2,14, 8,14, 8,-900, 8 :'IF_IRR_R
  388.  DATA 2,30, 2,30,16,30,16,-882,16 :'IF_IDD_D
  389.  
  390.  DATA "IMP",2,14,1
  391.  DATA 1, 2, 2, 2, 2,-918, 2 :'IMP_II_I
  392.  DATA 1,30, 4,30, 4,-924, 4 :'IMP_LL_L
  393.  
  394.  DATA "INKEY$",3,1,0
  395.  DATA -1,-930, 1 :'INKEY__T
  396.  
  397.  DATA "INPUT$",3,1,0
  398.  DATA 1,30, 2,30, 2,-936, 1 :'INPUT_II_T
  399.  
  400.  DATA "INSTR",3,1,1
  401.  DATA 1, 1, 1, 1, 1,-954, 2 :'INSTR_TT_I
  402.  DATA 2,30, 2, 1, 1, 1, 1,-948, 2 :'INSTR_ITT_I
  403.  
  404.  DATA "INT",3,1,3
  405.  DATA 0, 2, 2,0, 2 :'NOTHING__
  406.  DATA 0, 4, 4,0, 4 :'NOTHING__
  407.  DATA 0, 8, 8,-966, 8 :'INT_R_R
  408.  DATA 0,16,16,-960,16 :'INT_D_D
  409.  
  410.  DATA "LEFT$",3,1,0
  411.  DATA 1, 1, 1,30, 2,-978, 1 :'LEFT_TI_T
  412.  
  413.  DATA "LEN",3,1,0
  414.  DATA 0, 1, 1,-984, 2 :'LEN_T_I
  415.  
  416.  DATA "LOC",3,1,0
  417.  DATA 0, 2, 2,-1068, 4 :'LOC_I_L
  418.  
  419.  DATA "LOF",3,1,0
  420.  DATA 0, 2, 2,-1074, 4 :'LOF_I_L
  421.  
  422.  DATA "LOG",3,1,1
  423.  DATA 0,14, 8,-1086, 8 :'LOG_R_R
  424.  DATA 0,16,16,-1080,16 :'LOG_D_D
  425.  
  426.  DATA "LPOS",3,1,0
  427.  DATA 0,30, 2,-1092, 2 :'LPOS_I_I
  428.  
  429.  DATA "MENU",3,1,0
  430.  DATA 0,30, 2,-1206, 2 :'MENU_I_I
  431.  
  432.  DATA "MID$",3,1,1
  433.  DATA 2, 1, 1,30, 2,30, 2,-1212, 1 :'MID_TII_T
  434.  DATA 1, 1, 1,30, 2,-1218, 1 :'MID_TI_T
  435.  
  436.  DATA "MKD$",3,1,0
  437.  DATA 0,30,16,-1224, 1 :'MKD_D_T
  438.  
  439.  DATA "MKI$",3,1,0
  440.  DATA 0,30, 2,-1230, 1 :'MKI_I_T
  441.  
  442.  DATA "MKL$",3,1,0
  443.  DATA 0,30, 4,-1236, 1 :'MKL_L_T
  444.  
  445.  DATA "MKS$",3,1,0
  446.  DATA 0,30, 8,-1242, 1 :'MKS_R_T
  447.  
  448.  DATA "MOD",2,6,1
  449.  DATA 1, 2, 2, 2, 2,-1248, 2 :'MOD_II_I
  450.  DATA 1,30, 4,30, 4,-1254, 4 :'MOD_LL_L
  451.  
  452.  DATA "MOUSE",3,1,0
  453.  DATA 0,30, 2,-1278, 2 :'MOUSE_I_I
  454.  
  455.  DATA "NOT",1,9,1
  456.  DATA 0, 2, 2,-1392, 2 :'NOT_I_I
  457.  DATA 0,30, 4,-1398, 4 :'NOT_L_L
  458.  
  459.  DATA "OBJECT.VX",3,1,0
  460.  DATA 0,30, 2,-1530, 2 :'OBJECT.VX_I_I
  461.  
  462.  DATA "OBJECT.VY",3,1,0
  463.  DATA 0,30, 2,-1542, 2 :'OBJECT.VY_I_I
  464.  
  465.  DATA "OBJECT.X",3,1,0
  466.  DATA 0,30, 2,"OBJECT.X", 2
  467.  
  468.  DATA "OBJECT.Y",3,1,0
  469.  DATA 0,30, 2,"OBJECT.Y", 2
  470.  
  471.  DATA "OCT$",3,1,0
  472.  DATA 0,30, 4,-1560, 1 :'OCT_L_T
  473.  
  474.  DATA "OR",2,11,1
  475.  DATA 1, 2, 2, 2, 2,-1638, 2 :'OR_II_I
  476.  DATA 1,30, 4,30, 4,-1644, 4 :'OR_LL_L
  477.  
  478.  DATA "PEEK",3,1,0
  479.  DATA 0,30, 4,-1686, 2 :'PEEK_L_I
  480.  
  481.  DATA "PEEKL",3,1,0
  482.  DATA 0,30, 4,-1674, 4 :'PEEKL_L_L
  483.  
  484.  DATA "PEEKW",3,1,0
  485.  DATA 0,30, 4,-1680, 2 :'PEEKW_L_I
  486.  
  487.  DATA "POINT",3,1,0
  488.  DATA 1,30, 2,30, 2,-1692, 2 :'POINT_II_I
  489.  
  490.  DATA "POS",3,1,0
  491.  DATA 0,30, 2,-1716, 2 :'POS_I_I
  492.  
  493.  DATA "RIGHT$",3,1,0
  494.  DATA 1, 1, 1,30, 2,-1854, 1 :'RIGHT_TI_T
  495.  
  496.  DATA "RND",3,1,1
  497.  DATA 0, 2, 2,-1860, 8 :'RND_I_R
  498.  DATA -1,-1866,8 :'RND__R
  499.  
  500.  DATA "SADD",3,1,0
  501.  DATA 0, 1, 1,-1884, 4 :'SADD_T_L
  502.  
  503.  DATA "SGN",3,1,3
  504.  DATA 0, 2, 2,-1974, 2 :'SGN_I_I
  505.  DATA 0, 4, 4,-1980, 2 :'SGN_L_I
  506.  DATA 0, 8, 8,-1986, 2 :'SGN_R_I
  507.  DATA 0,16,16,-1968, 2 :'SGN_D_I
  508.  
  509.  DATA "SIN",3,1,1
  510.  DATA 0,14, 8,-1998, 8 :'SIN_R_R
  511.  DATA 0,16,16,-1992,16 :'SIN_D_D
  512.  
  513.  DATA "SPACE$",3,1,0
  514.  DATA 0,30, 2,-2028, 1 :'SPACE_I_T
  515.  
  516.  DATA "SQR",3,1,1
  517.  DATA 0,14, 8,-2046, 8 :'SQR_R_R
  518.  DATA 0,16,16,-2034,16 :'SQR_D_D
  519.  
  520.  DATA "STICK",3,1,0
  521.  DATA 0,30, 2,-2052, 2 :'STICK_I_I
  522.  
  523.  DATA "STR$",3,1,3
  524.  DATA 0, 2, 2,-2082, 1 :'STR_I_T
  525.  DATA 0, 4, 4,-2088, 1 :'STR_L_T
  526.  DATA 0, 8, 8,-2094, 1 :'STR_R_T
  527.  DATA 0,16,16,-2076, 1 :'STR_D_T
  528.  
  529.  DATA "STRIG",3,1,0
  530.  DATA 0,30, 2,-2058, 2 :'STRIG_I_I
  531.  
  532.  DATA "STRING$",3,1,1
  533.  DATA 1,30, 2,30, 2,-2064, 1 :'STRING_II_T
  534.  DATA 1,30, 2, 1, 1,-2070, 1 :'STRING_IT_T
  535.  
  536.  DATA "TAN",3,1,1
  537.  DATA 0,14, 8,-2172, 8 :'TAN_R_R
  538.  DATA 0,16,16,-2166,16 :'TAN_D_D
  539.  
  540.  DATA "TIME$",3,1,0
  541.  DATA -1,-2202, 1 :'TIME__T
  542.  
  543.  DATA "TIMER",3,1,0
  544.  DATA -1,-2196, 4 :'TIMER__L
  545.  
  546.  DATA "TRANSLATE$",3,1,0
  547.  DATA 0, 1, 1,-2208, 1 :'TRANSLATE_T_T
  548.  
  549.  DATA "UCASE$",3,1,0
  550.  DATA 0, 1, 1,-2226, 1 :'UCASE_T_T
  551.  
  552.  DATA "VAL",3,1,0
  553.  DATA 0, 1, 1,-2232,16 :'VAL_T_D
  554.  
  555.  DATA "WINDOW",3,1,0
  556.  DATA 0,30, 2,-2256, 4 :'WINDOW_I_L
  557.  
  558.  DATA "XOR",2,12,1
  559.  DATA 1, 2, 2, 2, 2,-2262, 2 :'XOR_II_I
  560.  DATA 1,30, 4,30, 4,-2268, 4 :'XOR_LL_L
  561.  
  562.  DATA "\",2,5,1
  563.  DATA 1, 2, 2, 2, 2,-462, 2 :'DIV_II_I
  564.  DATA 1,30, 4,30, 4,-468, 4 :'DIV_LL_L
  565.  
  566.  DATA "^",2,2,1
  567.  DATA 1,14, 8,14, 8,-1728, 8 :'POT_RR_R
  568.  DATA 1,30,16,30,16,-1722,16 :'POT_DD_D
  569.  
  570. '************************************************************
  571. '*                                                          *
  572. '* Konvertierungstabelle                                    *
  573. '*                                                          *
  574. '************************************************************
  575.  
  576.  DIM SHARED NumConv
  577.  READ NumConv
  578.  DIM SHARED CConvFrom(NumConv),CConvTo(NumConv),CConvOffset(NumConv)
  579.  FOR a = 0 TO NumConv
  580.    READ CConvFrom(a),CConvTo(a),CConvOffset(a)
  581.  NEXT a
  582.  
  583.  DATA 11
  584.  DATA  2, 4,-300 :'CONVERT_I_L
  585.  DATA  2, 8,-306 :'CONVERT_I_R
  586.  DATA  2,16,-294 :'CONVERT_I_D
  587.  DATA  4, 2,-318 :'CONVERT_L_I
  588.  DATA  4, 8,-324 :'CONVERT_L_R
  589.  DATA  4,16,-312 :'CONVERT_L_D
  590.  DATA  8, 2,-336 :'CONVERT_R_I
  591.  DATA  8, 4,-342 :'CONVERT_R_L
  592.  DATA  8,16,-330 :'CONVERT_R_D
  593.  DATA 16, 2,-276 :'CONVERT_D_I
  594.  DATA 16, 4,-282 :'CONVERT_D_L
  595.  DATA 16, 8,-288 :'CONVERT_D_R
  596.  
  597. '************************************************************
  598. '*                                                          *
  599. '* Parametereingaben                                        *
  600. '*                                                          *
  601. '************************************************************
  602.  
  603.  PRINT "Cursor V1.0 - A Basic-Compiler"
  604.  PRINT "(c) 1990 by Jürgen Forster"
  605.  PRINT
  606.  
  607.  PRINT "Write linenumbers into executable (Y/N)? ";
  608.  a$ = ""
  609.  WHILE INSTR("YN",a$) = 0 OR a$ = ""
  610.    a$ = UCASE$(INKEY$)
  611.  WEND
  612.  IsDebugUsed = a$ = "Y"
  613.  PRINT a$
  614.  
  615.  PRINT "Filename (without '.bas')? ";
  616.  LINE INPUT FileName$
  617.  
  618. '***********************************************************
  619. '*                                                          *
  620. '* Hauptprogramm, ruft alles auf                            *
  621. '*                                                          *
  622. '************************************************************
  623.  
  624. ' Anfangszeit nehmen
  625.  BeginTime& = TIMER
  626.  
  627. ' Nur Eingabefile öffnen, 1. Pass
  628.  Pass = 1
  629.  OPEN (FileName$+".bas") FOR INPUT AS 1
  630.  GOSUB GoThroughPass
  631.  CLOSE 1
  632.  
  633. ' Stack ueberpruefen
  634.  CALL TestStack (-1)
  635.  
  636. ' Label ueberpruefen
  637.  FOR a = 0 TO NumLabels
  638.    IF LabelLine(a) = FALSE THEN
  639.      IF INSTR(Label$(a),"_") = 0 THEN
  640.        PRINT : PRINT "Undefined label: "+Label$(a)
  641.        NumErrors = NumErrors+1
  642.      END IF
  643.    END IF
  644.  NEXT a
  645.  
  646. ' Variablenoffsets berechnen
  647.  GOSUB CalcVarOffsets
  648.  
  649. ' fehlt ein END SUB?
  650.  IF SubNumber <> 1 THEN CALL SomeError ("END SUB missing",-1)
  651.  
  652. ' Ist ein Fehler aufgetreten? Wenn ja, abbrechen
  653.  IF NumErrors <> 0 THEN
  654.    PRINT : PRINT "Found";NumErrors;" error(s) in pass 1 - aborting!"
  655.    CALL EndPrg
  656.  END IF
  657.  
  658. ' Nur Eingabefile öffnen, 2. Pass
  659.  Pass = 2
  660.  OPEN (FileName$+".bas") FOR INPUT AS 1
  661.  GOSUB WriteHeader
  662.  GOSUB GoThroughPass
  663.  CLOSE 1
  664.  IF (HunkOffset& AND 2) = 0 THEN
  665.    HunkSize& = HunkOffset&
  666.  ELSE
  667.    HunkSize& = HunkOffset&+2
  668.  END IF
  669.  
  670. ' Ist ein Fehler aufgetreten? Wenn ja, abbrechen
  671.  IF NumErrors <> 0 THEN
  672.    PRINT : PRINT "Found";NumErrors;" error(s) in pass 2 - aborting!"
  673.    CALL EndPrg
  674.  END IF
  675.  
  676. ' Aus- und Eingabe öffnen, 3. Pass
  677.  Pass = 3
  678.  OPEN (FileName$+".bas") FOR INPUT AS 1
  679.  OPEN (FileName$) FOR OUTPUT AS 2
  680.  OPEN ("T:Reloc32") FOR OUTPUT AS 3
  681.  GOSUB WriteHeader
  682.  GOSUB GoThroughPass
  683.  GOSUB WriteEnd
  684.  CLOSE 3
  685.  CLOSE 2
  686.  CLOSE 1
  687.  
  688. ' temporäres File löschen
  689.  KILL "T:Reloc32"
  690.  
  691. ' Zeitdauer ausgeben
  692.  PRINT : PRINT "Finished:";TIMER-BeginTime&;" s."
  693.  
  694. ' Fertig!
  695.  CALL EndPrg
  696.  
  697. '************************************************************
  698. '*                                                          *
  699. '* Den Anfang des Object-Files schreiben                    *
  700. '*                                                          *
  701. '************************************************************
  702.  
  703. WriteHeader:
  704.  
  705. ' Hunkheader
  706.  HunkOffset& = 0
  707.  CALL PrintToFile MKL$(1011)
  708.  CALL PrintToFile MKL$(0)
  709.  CALL PrintToFile MKL$(1)
  710.  CALL PrintToFile MKL$(0)
  711.  CALL PrintToFile MKL$(0)
  712.  CALL PrintToFile MKL$(HunkSize&\4)
  713.  CALL PrintToFile MKL$(1001)
  714.  CALL PrintToFile MKL$(HunkSize&\4)
  715.  HunkOffset& = 0
  716.  
  717. Header1:
  718.  DATA 40,0,42,8,44,120,0,4,118,0,38,110,1,20,74,171,0,172,102,18
  719.  DATA 65,235,0,92,78,174,254,128,65,235,0,92,78,174,254,140,38,0
  720.  DATA 67,250,0,50,78,174,254,104,74,128,102,2,78,117,44,64,69,250
  721.  DATA 0,54
  722.  DATA -1
  723.  
  724. Header2:
  725.  DATA 34,78,44,120,0,4,78,174,254,98,74,131,103,10,78,174,255,124
  726.  DATA 34,67,78,174,254,134,32,7,78,117
  727.  DATA -1
  728.  
  729.  RESTORE Header1
  730.  READ a
  731.  WHILE a <> -1
  732.    CALL PrintToFile CHR$(a)
  733.    READ a
  734.  WEND
  735.  CALL CallLib (-30)'INIT__
  736.  CALL SubSetLabel ("_EndPrg")
  737.  RESTORE Header2
  738.  READ a
  739.  WHILE a <> -1
  740.    CALL PrintToFile CHR$(a)
  741.    READ a
  742.  WEND
  743.  CALL PrintToFile "bas_runtime.library"
  744.  CALL PrintToFile CHR$(0)
  745.  
  746. ' Startup-Struktur ausgeben
  747.  CALL PrintToFile MKI$(0)              ' ST_Flags
  748.  CALL PrintToFile MKI$(44)             ' ST_Size
  749.  CALL PrintToFile MKI$(SubSize(0,0))   ' ST_GlobalStringsSize
  750.  CALL PrintToFile MKI$(SubSize(0,1))   ' ST_GlobalVarsSize
  751.  CALL PrintToFile MKI$(NumStrings*4+4) ' ST_GlobalConstStringsSize
  752.  CALL SubDumpOnlyLabel "_ConstStrings" ' ST_ConstStringsPointer
  753.  CALL SubDumpOnlyLabel "_DataStart"    ' ST_DataPointer
  754.  CALL PrintToFile MKI$(NumData)        ' ST_NumData
  755.  CALL PrintToFile MKL$(200000&)        ' ST_StringsMemSize
  756.  CALL PrintToFile MKL$(4000)           ' ST_StackMemSize
  757.  CALL SubDumpOnlyLabel "_EndPrg"       ' ST_EndPrg
  758.  CALL SubDumpOnlyLabel "_Start"
  759.  
  760. ' konstante Strings ausgeben
  761.  CALL SubSetLabel "_ConstStrings"
  762.  FOR a = 0 TO NumStrings
  763.    CALL PrintToFile MKI$(LEN(SString$(a)))
  764.    CALL PrintToFile SString$(a)
  765.    IF LEN(SString$(a)) AND 1 THEN
  766.      CALL PrintToFile CHR$(0)
  767.    ELSE
  768.      CALL PrintToFile MKI$(0)
  769.    END IF
  770.  NEXT a
  771.  
  772. ' DATAs ausgeben
  773.  CALL SubSetLabel "_DataStart"
  774.  FOR a = 0 TO NumData
  775.    CALL PrintToFile MKI$(DataStringOffset(a))
  776.  NEXT a
  777.  
  778. ' Einsprungadresse
  779.  CALL SubSetLabel "_Start"
  780.  
  781.  RETURN
  782.  
  783. '************************************************************
  784. '*                                                          *
  785. '* Das Ende des Object-Files schreiben                      *
  786. '*                                                          *
  787. '************************************************************
  788.  
  789. WriteEnd:
  790.  IF HunkOffset& <> HunkSize& THEN CALL PrintToFile MKI$(0)
  791.  CLOSE 3
  792.  CALL PrintToFile MKL$(1004)
  793.  OPEN ("T:Reloc32") FOR INPUT AS #3
  794.  CALL PrintToFile MKL$(LOF(3)\4)
  795.  CALL PrintToFile MKL$(0)
  796.  WHILE NOT EOF(3)
  797.    CALL PrintToFile INPUT$(4,3)
  798.  WEND
  799.  CALL PrintToFile MKL$(0)
  800.  CALL PrintToFile MKL$(1010)
  801.  RETURN
  802.  
  803. '************************************************************
  804. '*                                                          *
  805. '* Variablenadressen berechnen                              *
  806. '*                                                          *
  807. '************************************************************
  808.  
  809. CalcVarOffsets:
  810. ' Size löschen
  811.  FOR a = 0 TO MaxSubs
  812.    SubSize(a,0) = 0
  813.    SubSize(a,1) = 0
  814.  NEXT a
  815.  
  816. ' Größen berechnen
  817.  FOR a = 0 TO NumVars
  818.    IF VarType(a) >= 0 THEN
  819.      SubSize(VarSubNum(a),1) = SubSize(VarSubNum(a),1)+24+VarType(a)*2
  820.      VarOffset(a) = 0-SubSize(VarSubNum(a),1)
  821.    ELSE
  822.      IF VarFlags(a) = VarTEXT THEN
  823.        SubSize(VarSubNum(a),0) = SubSize(VarSubNum(a),0)+4
  824.        VarOffset(a) = 0-SubSize(VarSubNum(a),0)
  825.      ELSEIF VarFlags(a) = VarINT THEN
  826.        SubSize(VarSubNum(a),1) = SubSize(VarSubNum(a),1)+2
  827.        VarOffset(a) = 0-SubSize(VarSubNum(a),1)
  828.      ELSEIF VarFlags(a) = VarLONG THEN
  829.        SubSize(VarSubNum(a),1) = SubSize(VarSubNum(a),1)+4
  830.        VarOffset(a) = 0-SubSize(VarSubNum(a),1)
  831.      ELSEIF VarFlags(a) = VarREAL THEN
  832.        SubSize(VarSubNum(a),1) = SubSize(VarSubNum(a),1)+4
  833.        VarOffset(a) = 0-SubSize(VarSubNum(a),1)
  834.      ELSEIF VarFlags(a) = VarDOUB THEN
  835.        SubSize(VarSubNum(a),1) = SubSize(VarSubNum(a),1)+8
  836.        VarOffset(a) = 0-SubSize(VarSubNum(a),1)
  837.      END IF
  838.    END IF
  839.  NEXT a
  840.  
  841. ' Wirkliche Adressen berechnen
  842.  FOR a = 0 TO NumVars
  843.    IF VarType(a) >= 0 OR VarFlags(a) <> VarTEXT THEN
  844.      VarOffset(a) = VarOffset(a)-SubSize(VarSubNum(a),0)
  845.    END IF
  846.  NEXT a
  847.  
  848.  StringBase = SubSize(0,0)+SubSize(0,1)
  849.  
  850.  RETURN
  851.  
  852. '************************************************************
  853. '*                                                          *
  854. '* Einen Pass ganz durchgehen                               *
  855. '*                                                          *
  856. '************************************************************
  857.  
  858. GoThroughPass:
  859.  PRINT
  860.  
  861. ' Label-Zähler auf Null setzen
  862.  LabelCounter = 0
  863.  
  864. ' Zu Anfang sind wir im Hauptprogramm
  865.  SubNumber = 1
  866.  
  867. ' Zähler für Unterprogramme (1. hat die Nummer 2)
  868.  SubCounter = 1
  869.  
  870. ' Zeilennummer setzen
  871.  ThisLine = 0
  872.  
  873. ' Defaulteinstellung setzen
  874.  FOR a = 0 TO ASC("Z")-ASC("A")
  875.    CharVarType(a) = VarREAL
  876.  NEXT a
  877.  
  878. ' Stack fuer lokale Variable des Hauptprogramms reservieren
  879.  IF Pass > 1 THEN
  880.    CALL SubIntToString (SubSize(1,0))
  881.    CALL SubDumpVar (Ergebnis$,VarINT+VarCONST,-1)
  882.    CALL SubIntToString (SubSize(1,1))
  883.    CALL SubDumpVar (Ergebnis$,VarINT+VarCONST,-1)
  884.    CALL CallLib (-2106)'SUB_II_
  885.  END IF
  886.  
  887. ' Schleife ueber das ganze File
  888.  WHILE EOF(1) = 0
  889.  
  890. ' Ausgabe auf den Bildschirm
  891.    LINE INPUT #1,SourceLine$
  892.    ThisLine = ThisLine+1
  893.    PRINT "Pass";Pass;":";ThisLine;CHR$(13);
  894.  
  895. ' gesamte Zeile 'aufsplitten'
  896.    ErrorInThisLine = FALSE
  897.    FirstWord = 0
  898.    LastWord = -1
  899.    EndOfSourceLinePointer = 1
  900.    LinePointer = 1
  901.    WHILE LinePointer <= LEN(SourceLine$) AND ErrorInThisLine = FALSE
  902.      a$ = MID$(SourceLine$,LinePointer,1)
  903.      IF a$ = " " OR a$ = CHR$(9) THEN
  904.        GOSUB SkipSpaces
  905.      ELSEIF a$ = "'" THEN
  906.        LinePointer = LEN(SourceLine$)+1
  907.      ELSEIF INSTR("+-*/\^(),;:#%$!",a$) THEN
  908.        LastWord = LastWord+1
  909.        Word$(LastWord) = a$
  910.        WordPos(LastWord) = EndOfSourceLinePointer
  911.        IsVar(LastWord) = FALSE
  912.        CALL GetOperatorNum (a$)
  913.        OperatorNum(LastWord) = Ergebnis
  914.        EndOfSourceLinePointer = EndOfSourceLinePointer+1
  915.        LinePointer = LinePointer+1
  916.      ELSEIF INSTR(CharVarBegin$,a$) THEN
  917.        LastWord = LastWord+1
  918.        WordPos(LastWord) = EndOfSourceLinePointer
  919.        a = 1
  920.        WHILE a+LinePointer <= LEN(SourceLine$) AND INSTR(CharVarMid$,MID$(SourceLine$,a+LinePointer,1))
  921.          a = a+1
  922.        WEND
  923.        Word$(LastWord) = UCASE$(MID$(SourceLine$,LinePointer,a))
  924.        CALL IsKeyWord (Word$(LastWord))
  925.        IF Ergebnis = FALSE THEN
  926.          IF a+LinePointer <= LEN(SourceLine$) AND INSTR(CharTypes$,MID$(SourceLine$,a+LinePointer,1)) <> 0 THEN
  927.            a = a+1
  928.          END IF
  929.          Word$(LastWord) = UCASE$(MID$(SourceLine$,LinePointer,a))
  930.          CALL IsKeyWord (Word$(LastWord))
  931.        ELSE
  932.          IF a+LinePointer <= LEN(SourceLine$) AND INSTR(CharTypes$,MID$(SourceLine$,a+LinePointer,1)) <> 0 THEN
  933.            try$ = UCASE$(MID$(SourceLine$,LinePointer,a+1))
  934.            CALL IsKeyWord (try$)
  935.            IF Ergebnis = TRUE THEN
  936.              Word$(LastWord) = try$
  937.              a = a+1
  938.            ELSE
  939.              Ergebnis = TRUE
  940.            END IF
  941.          END IF
  942.        END IF
  943.        IF Ergebnis THEN
  944.          IsVar(LastWord) = FALSE
  945.        ELSE
  946.          CALL GetVarFlags (Word$(LastWord))
  947.          WordVarFlags(LastWord) = Ergebnis
  948.          IsVar(LastWord) = TRUE
  949.        END IF
  950.        CALL GetOperatorNum (Word$(LastWord))
  951.        OperatorNum(LastWord) = Ergebnis
  952.        EndOfSourceLinePointer = EndOfSourceLinePointer+a
  953.        LinePointer = LinePointer+a
  954.        IF Word$(LastWord) = "REM" THEN
  955.          LastWord = LastWord-1
  956.          LinePointer = LEN(SourceLine$)+1
  957.        ELSEIF Word$(LastWord) = "DATA" THEN
  958.          GOSUB SkipSpaces
  959.          AddData = TRUE
  960.          WHILE AddData
  961.            IF LinePointer <= LEN(SourceLine$) THEN
  962.              IF MID$(SourceLine$,LinePointer,1) = CHR$(34) THEN
  963.                EndOfSourceLinePointer = EndOfSourceLinePointer+1
  964.                LinePointer = LinePointer+1
  965.                Abort$ = CHR$(34) : GOSUB AddStringTillAbort
  966.                IF LinePointer <= LEN(SourceLine$) THEN
  967.                  EndOfSourceLinePointer = EndOfSourceLinePointer+1
  968.                  LinePointer = LinePointer+1
  969.                END IF
  970.              ELSE
  971.                Abort$ = ",:" : GOSUB AddStringTillAbort
  972.                WHILE LEFT$(Add$,1) = " "
  973.                  Add$ = RIGHT$(Add$,LEN(Add$)-1)
  974.                WEND
  975.                WHILE RIGHT$(Add$,1) = " "
  976.                  Add$ = LEFT$(Add$,LEN(Add$)-1)
  977.                WEND
  978.              END IF
  979.              CALL AddData (Add$)
  980.              GOSUB SkipSpaces
  981.              IF LinePointer <= LEN(SourceLine$) THEN
  982.                IF MID$(SourceLine$,LinePointer,1) = ":" THEN
  983.                  AddData = FALSE
  984.                ELSEIF MID$(SourceLine$,LinePointer,1) = "," THEN
  985.                  EndOfSourceLinePointer = EndOfSourceLinePointer+1
  986.                  LinePointer = LinePointer+1
  987.                  GOSUB SkipSpaces
  988.                ELSE
  989.                  CALL SomeError ("syntaxerror after DATA-command",EndOfSourceLinePointer)
  990.                  LinePointer = LEN(SourceLine$)+1
  991.                  AddData = FALSE
  992.                END IF
  993.              ELSE
  994.                AddData = FALSE
  995.              END IF
  996.            ELSE
  997.              CALL AddData ("")
  998.              AddData = FALSE
  999.            END IF
  1000.          WEND
  1001.        END IF
  1002.      ELSEIF a$ = CHR$(34) THEN
  1003.        LastWord = LastWord+1
  1004.        WordPos(LastWord) = EndOfSourceLinePointer
  1005.        IsVar(LastWord) = TRUE
  1006.        OperatorNum(LastWord) = -1
  1007.        WordVarFlags(LastWord) = VarTEXT OR VarCONST
  1008.        EndOfSourceLinePointer = EndOfSourceLinePointer+1
  1009.        LinePointer = LinePointer+1
  1010.        Abort$ = CHR$(34) : GOSUB AddStringTillAbort
  1011.        Word$(LastWord) = CHR$(34)+Add$
  1012.        IF LinePointer <= LEN(SourceLine$) THEN
  1013.          EndOfSourceLinePointer = EndOfSourceLinePointer+1
  1014.          LinePointer = LinePointer+1
  1015.        END IF
  1016.      ELSEIF INSTR("<>=",a$) THEN
  1017.        LastWord = LastWord+1
  1018.        Word$(LastWord) = ""
  1019.        WordPos(LastWord) = EndOfSourceLinePointer
  1020.        IsVar(LastWord) = FALSE
  1021.        LessUsed = FALSE : EquUsed = FALSE : MoreUsed = FALSE
  1022.        a = 0
  1023.        WHILE a+LinePointer <= LEN(SourceLine$) AND INSTR("<=>",MID$(SourceLine$,a+LinePointer,1)) <> 0
  1024.          IF MID$(SourceLine$,a+LinePointer,1) = "<" THEN
  1025.            LessUsed = TRUE
  1026.          ELSEIF MID$(SourceLine$,a+LinePointer,1) = "=" THEN
  1027.            EquUsed = TRUE
  1028.          ELSE
  1029.            MoreUsed = TRUE
  1030.          END IF
  1031.          a = a+1
  1032.        WEND
  1033.        IF LessUsed THEN Word$(LastWord) = Word$(LastWord)+"<"
  1034.        IF EquUsed THEN  Word$(LastWord) = Word$(LastWord)+"="
  1035.        IF MoreUsed THEN Word$(LastWord) = Word$(LastWord)+">"
  1036.        IF Word$(LastWord) = "<=>" THEN
  1037.          CALL SomeError ("'<=>' is nonsense",EndOfSourceLinePointer) : LinePointer = LEN(SourceLine$)+1
  1038.        ELSE
  1039.          CALL GetOperatorNum (Word$(LastWord))
  1040.          OperatorNum(LastWord) = Ergebnis
  1041.          EndOfSourceLinePointer = EndOfSourceLinePointer+a
  1042.          LinePointer = LinePointer+a
  1043.        END IF
  1044.      ELSE
  1045.        CALL SomeError ("Syntax error",EndOfSourceLinePointer)
  1046.        LinePointer = LEN(SourceLine$)+1
  1047.      END IF
  1048.      IF LastWord+10 >= MaxWords THEN
  1049.        CALL SomeError ("Line too long",EnfOfSourceLinePointer)
  1050.        LinePointer = LEN(SourceLine$)+1
  1051.      END IF
  1052.    WEND
  1053.    WordPos(LastWord+1) = EndOfSourceLinePointer
  1054.  
  1055. ' Ist eine Zeile durch eine Zahl definiert?
  1056.    IF ErrorInThisLine = FALSE THEN
  1057.      IF FirstWord <= LastWord THEN
  1058.        IF IsVar(FirstWord) THEN
  1059.          IF WordVarFlags(FirstWord) AND VarCONST THEN
  1060.            CALL CouldThisBeALabel (FirstWord)
  1061.            IF Ergebnis THEN
  1062.              CALL SubSetLabel (Word$(FirstWord))
  1063.              FirstWord = FirstWord+1
  1064.            END IF
  1065.          END IF
  1066.        END IF
  1067.      END IF
  1068.    END IF
  1069.  
  1070. ' Ist eine Zeile alphanumerisch deklariert?
  1071.    IF ErrorInThisLine = FALSE THEN
  1072.      IF FirstWord < LastWord THEN
  1073.        IF IsVar(FirstWord) = TRUE AND (WordVarFlags(FirstWord) AND VarCONST)= FALSE AND Word$(FirstWord+1) = ":" THEN
  1074.          CALL CouldThisBeALabel (FirstWord)
  1075.          IF Ergebnis THEN
  1076.            CALL SubSetLabel (Word$(FirstWord))
  1077.            FirstWord = FirstWord+2
  1078.          END IF
  1079.        END IF
  1080.      END IF
  1081.    END IF
  1082.  
  1083. ' Zeilennummern ggf. in File einfgen
  1084.    IF IsDebugUsed THEN
  1085.      CALL SubDumpVar (STR$(ThisLine),VarLONG+VarCONST,-1)
  1086.      CALL CallLib (-1920)'SETLINE_L_
  1087.    END IF
  1088.  
  1089. ' Soviele END IFs muessen ergänzt werden
  1090.    IfsToClose = 0
  1091.  
  1092. ' IF ... THEN oder ELSEIF ... THEN behandeln
  1093.    WHILE FirstWord <= LastWord AND ErrorInThisLine = FALSE
  1094.      IF Word$(FirstWord) = "IF" OR Word$(FirstWord) = "ELSEIF" THEN
  1095.        LastCommWord = FirstWord
  1096.        CContSearch = TRUE
  1097.        WHILE CContSearch
  1098.          IF LastCommWord < LastWord THEN
  1099.            IF Word$(LastCommWord+1) = "THEN" OR Word$(LastCommWord+1) = "GOTO" THEN
  1100.              CContSearch = FALSE
  1101.            ELSE
  1102.              LastCommWord = LastCommWord+1
  1103.            END IF
  1104.          ELSE
  1105.            CALL SomeError ("'THEN' or 'GOTO' expected after IF/ELSEIF",WordPos(FirstWord))
  1106.            CContSearch = FALSE
  1107.          END IF
  1108.        WEND
  1109.        IF ErrorInThisLine = FALSE THEN
  1110.          CALL DumpCommand (FirstWord,LastCommWord)
  1111.          FirstWord = LastCommWord+1
  1112.          IF Word$(FirstWord) = "THEN" THEN
  1113.            ForceGoto = FALSE
  1114.            IF FirstWord < LastWord THEN
  1115.              IF FirstWord+1 = LastWord OR Word$(FirstWord+2) = "ELSE" OR Word$(FirstWord+2) = ":" THEN CALL CouldThisBeALabel (FirstWord+1) : ForceGoto = Ergebnis
  1116.            END IF
  1117.            IF ForceGoto THEN
  1118.              Word$(FirstWord) = "GOTO"
  1119.              IfsToClose = IfsToClose+1
  1120.            ELSE
  1121.              FirstWord = FirstWord+1
  1122.              IF FirstWord <= LastWord THEN IfsToClose = IfsToClose+1
  1123.            END IF
  1124.          END IF
  1125.        END IF
  1126.      ELSEIF Word$(FirstWord) = ":" THEN
  1127.        FirstWord = FirstWord+1
  1128.      ELSEIF Word$(FirstWord) = "ELSE" THEN
  1129.        CALL DumpCommand (FirstWord,FirstWord)
  1130.        FirstWord = FirstWord+1
  1131.      ELSE
  1132.        LastCommWord = FirstWord-1
  1133.        WHILE LastCommWord < LastWord AND Word$(LastCommWord+1) <> ":" AND Word$(LastCommWord+1) <> "ELSE"
  1134.          LastCommWord = LastCommWord+1
  1135.        WEND
  1136.        CALL DumpCommand (FirstWord,LastCommWord)
  1137.        FirstWord = LastCommWord+1
  1138.      END IF
  1139.    WEND
  1140.  
  1141. ' fehlende END IFs ergänzen
  1142.    WHILE ErrorInThisLine = FALSE AND IfsToClose > 0
  1143.      FirstWord = 0 : LastWord = 1
  1144.      Word$(FirstWord) = "END" : IsVar(LastWord) = FALSE : WordPos(FirstWord) = -1
  1145.      Word$(LastWord) = "IF" : IsVar(LastWord) = FALSE : WordPos(LastWord) = -1
  1146.      WordPos(2) = -1
  1147.      CALL DumpCommand (FirstWord,LastWord)
  1148.      IfsToClose = IfsToClose-1
  1149.    WEND
  1150.  
  1151.  WEND
  1152.  
  1153.  FirstWord = 0 : LastWord = 0
  1154.  Word$(FirstWord) = "END" : IsVar(FirstWord) = FALSE : WordPos(LastWord) = -1
  1155.  WordPos(1) = -1
  1156.  CALL DumpCommand (FirstWord,LastWord)
  1157.  RETURN
  1158.  
  1159. SkipSpaces:
  1160.  WHILE LinePointer <= LEN(SourceLine$) AND INSTR(" "+CHR$(9),MID$(SourceLine$,LinePointer,1)) <> 0
  1161.    IF MID$(SourceLine$,LinePointer,1) = " " THEN
  1162.      EndOfSourceLinePointer = EndOfSourceLinePointer+1
  1163.      LinePointer = LinePointer+1
  1164.    ELSE
  1165.      EndOfSourceLinePointer = INT((EndOfSourceLinePointer+8)\8)*8
  1166.      LinePointer = LinePointer+1
  1167.    END IF
  1168.  WEND
  1169.  RETURN
  1170.  
  1171. AddStringTillAbort:
  1172.  Add$ = ""
  1173.  CContAdding = TRUE
  1174.  WHILE CContAdding
  1175.    IF LinePointer <= LEN(SourceLine$) THEN
  1176.      a$ = MID$(SourceLine$,LinePointer,1)
  1177.      IF INSTR(Abort$,a$) THEN
  1178.        CContAdding = FALSE
  1179.      ELSEIF a$ = CHR$(9) THEN
  1180.        NewEndOfSourceLinePointer = INT((EndOfSourceLinePointer+8)\8)*8
  1181.        Add$ = Add$+SPACE$(NewEndOfSourceLinePointer-EndOfSourceLinePointer)
  1182.        EndOfSourceLinePointer = NewEndOfSourceLinePointer
  1183.        LinePointer = LinePointer+1
  1184.      ELSE
  1185.        Add$ = Add$+a$
  1186.        EndOfSourceLinePointer = EndOfSourceLinePointer+1
  1187.        LinePointer = LinePointer+1
  1188.      END IF
  1189.    ELSE
  1190.      CContAdding = FALSE
  1191.    END IF
  1192.  WEND
  1193.  RETURN
  1194.  
  1195. '************************************************************
  1196. '*                                                          *
  1197. '* Wertet einen Befehl aus                                  *
  1198. '*                                                          *
  1199. '************************************************************
  1200.  
  1201. SUB DumpCommand (Word1,Word2) STATIC
  1202.  FirstWord = Word1 : LastWord = Word2
  1203.  IF FirstWord > LastWord THEN
  1204.    CALL SomeError ("Command expected",WordPos(FirstWord)) : EXIT SUB
  1205.  END IF
  1206.  
  1207. ' Ist das 1. Wort kein Schlueßelwort, so mueßen wir CALL oder LET erraten
  1208.  CALL IsKeyWord (Word$(FirstWord))
  1209.  IF Ergebnis = FALSE THEN
  1210.    CommandPos = -1
  1211.    Command$ = "LET"
  1212.    CALL GetVarEnd (FirstWord,LastWord,FALSE)
  1213.    IF Ergebnis = -1 OR Ergebnis = LastWord THEN
  1214.      Command$ = "CALL"
  1215.    ELSE
  1216.      IF Word$(Ergebnis+1) <> "=" THEN
  1217.        Command$ = "CALL"
  1218.      END IF
  1219.    END IF
  1220.  ELSE
  1221.    CommandPos = WordPos(FirstWord)
  1222.    Command$ = Word$(FirstWord)
  1223.    GOSUB SkipOneWord
  1224.  END IF
  1225.  
  1226. '
  1227. ' Von hier ab werden alle Befehle ausgewertet
  1228. '
  1229.  
  1230.  NotFound = 0
  1231.  
  1232. ' AREA [STEP] (x,y)
  1233.  IF Command$ = "AREA" THEN
  1234.    GOSUB DumpGfxPoint
  1235.    CALL CallLib (-120)'AREA_II_
  1236.  
  1237. ' AREAFILL [Modus]
  1238.  ELSEIF Command$ = "AREAFILL" THEN
  1239.    IF FirstWord > LastWord THEN
  1240.      CALL CallLib (-114)'AREAFILL__
  1241.    ELSE
  1242.      ExprFlags = VarINT : GOSUB DumpExpr
  1243.      CALL CallLib (-108)'AREAFILL_I_
  1244.    END IF
  1245.  
  1246. ' BEEP
  1247.  ELSEIF Command$ = "BEEP" THEN
  1248.    CALL CallLib (-144)'BEEP__
  1249.  
  1250. ' BREAK ON / BREAK OFF / BREAK STOP
  1251.  ELSEIF Command$ = "BREAK" THEN
  1252.    IF FirstWord <= LastWord AND Word$(FirstWord) = "ON" THEN
  1253.      GOSUB SkipOneWord
  1254.      CALL CallLib (-156)'BREAKON__
  1255.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "OFF" THEN
  1256.      GOSUB SkipOneWord
  1257.      CALL CallLib (-150)'BREAKOFF__
  1258.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "STOP" THEN
  1259.      GOSUB SkipOneWord
  1260.      CALL CallLib (-162)'BREAKSTOP__
  1261.    ELSE
  1262.      GOTO SyntaxError
  1263.    END IF
  1264.  
  1265. ' [CALL] Sprungmarke [(Argumentliste)] / [CALL] num Var [(Argumentliste)]
  1266.  ELSEIF Command$ = "CALL" THEN
  1267.    IF FirstWord > LastWord THEN CALL SomeError ("Expected a label",WordPos(FirstWord)) : EXIT SUB
  1268.    CALL CouldThisBeALabel (FirstWord)
  1269.    IF Ergebnis = FALSE THEN CALL SomeError ("Expected a label",WordPos(FirstWord)) : EXIT SUB
  1270.    LabelPointer = FirstWord
  1271.    GOSUB SkipOneWord
  1272.    CALL TryRemBrackets (FirstWord,LastWord)
  1273.    FirstWord = FirstWord+Ergebnis
  1274.    LastWord = LastWord-Ergebnis
  1275.    IF Pass = 1 THEN
  1276.      ExpectKomma = FALSE
  1277.      WHILE FirstWord <= LastWord
  1278.        IF ExpectKomma THEN
  1279.          GOSUB SkipKomma
  1280.        ELSE
  1281.          ExpectKomma = TRUE
  1282.        END IF
  1283.        ExprFlags = VarTEXT OR VarINT OR VarLONG OR VarREAL OR VarDOUB : GOSUB DumpExpr
  1284.      WEND
  1285.    ELSE
  1286.      CALL GetMySubNum (Word$(LabelPointer),FALSE)
  1287.      IF Ergebnis = -1 THEN EXIT SUB
  1288.      MySubNumber = Ergebnis
  1289.      ExpectKomma = FALSE
  1290.      FOR a = 0 TO NumSubPars(MySubNumber)
  1291.        IF ExpectKomma THEN
  1292.          GOSUB SkipKomma
  1293.        ELSE
  1294.          ExpectKomma = TRUE
  1295.        END IF
  1296.        ParPos(a) = FirstWord
  1297.        SaveConvErrorPos = WordPos(FirstWord)
  1298.        ExprFlags = VarTEXT OR VarINT OR VarLONG OR VarREAL OR VarDOUB : GOSUB DumpExpr
  1299.        CALL TryConv (Ergebnis,SubParType(MySubNumber,a),SaveConvErrorPos)
  1300.        IF Ergebnis = FALSE THEN EXIT SUB
  1301.      NEXT a
  1302.      IF FirstWord <= LastWord THEN CALL SomeError ("CALL: Too many parameters",WordPos(FirstWord)) : EXIT SUB
  1303.      CALL SubDumpLabel ("_"+Word$(LabelPointer))
  1304.      CALL CallLib (-168)'CALL_Z_
  1305.      FOR a = NumSubPars(MySubNumber) TO 0 STEP -1
  1306.        FirstWord = ParPos(a)
  1307.        CALL GetExprEnd (FirstWord,LastWord)
  1308.        IF Ergebnis = -1 THEN EXIT SUB
  1309.        EndOfExpr = Ergebnis
  1310.        CALL GetVarEnd (FirstWord,LastWord,FALSE)
  1311.        IF Ergebnis = -1 OR Ergebnis <> EndOfExpr THEN
  1312.          IF SubParType(MySubNumber,a) = VarTEXT THEN
  1313.            CALL CallLib (-702)'FORGET_T_
  1314.          ELSEIF SubParType(MySubNumber,a) = VarINT THEN
  1315.            CALL CallLib (-684)'FORGET_I_
  1316.          ELSEIF SubParType(MySubNumber,a) = VarLONG THEN
  1317.            CALL CallLib (-690)'FORGET_L_
  1318.          ELSEIF SubParType(MySubNumber,a) = VarREAL THEN
  1319.            CALL CallLib (-696)'FORGET_R_
  1320.          ELSEIF SubParType(MySubNumber,a) = VarDOUB THEN
  1321.            CALL CallLib (-678)'FORGET_D_
  1322.          END IF
  1323.        ELSE
  1324.          CALL SubDumpSetVar (FirstWord,Ergebnis,SubParType(MySubNumber,a))
  1325.          IF Ergebnis = FALSE THEN EXIT SUB
  1326.        END IF
  1327.      NEXT a
  1328.      FirstWord = LastWord+1
  1329.    END IF
  1330.  
  1331. ' CHAIN [MERGE] Dateiangabe[,[Zeile][,[ALL][,DELETE Bereich]]]
  1332.  ELSEIF Command$ = "CHAIN" THEN
  1333.    GOTO NotCompilable
  1334.  
  1335. ' CHDIR Pfad
  1336.  ELSEIF Command$ = "CHDIR" THEN
  1337.    ExprFlags = VarTEXT : GOSUB DumpExpr
  1338.    CALL CallLib (-174)'CHDIR_T_
  1339.  
  1340. ' CIRCLE [STEP] (x,y),r[,Farbe[,Start,Ende[,Bild]]]
  1341.  ELSEIF Command$ = "CIRCLE" THEN
  1342.    GOSUB DumpGfxPoint
  1343.    GOSUB SkipKomma
  1344.    ExprFlags = VarINT : GOSUB DumpExpr
  1345.    IF FirstWord > LastWord THEN
  1346.      CALL CallLib (-210)'CIRCLE_III_
  1347.    ELSE
  1348.      GOSUB SkipKomma
  1349.      ExprFlags = VarINT : GOSUB DumpExpr
  1350.      IF FirstWord > LastWord THEN
  1351.        CALL CallLib (-204)'CIRCLE_IIII_
  1352.      ELSE
  1353.        GOSUB SkipKomma
  1354.        ExprFlags = VarREAL : GOSUB DumpExpr
  1355.        GOSUB SkipKomma
  1356.        ExprFlags = VarREAL : GOSUB DumpExpr
  1357.        IF FirstWord > LastWord THEN
  1358.          CALL CallLib (-198)'CIRCLE_IIIIRR_
  1359.        ELSE
  1360.          GOSUB SkipKomma
  1361.          ExprFlags = VarREAL : GOSUB DumpExpr
  1362.          CALL CallLib (-192)'CIRCLE_IIIIRRR_
  1363.        END IF
  1364.      END IF
  1365.    END IF
  1366.  
  1367. ' CLEAR [,[Prg][,Stap]]
  1368.  ELSEIF Command$ = "CLEAR" THEN
  1369.    CALL CallLib (-216)'CLEAR__
  1370.    IF FirstWord <= LastWord THEN GOSUB SkipKomma
  1371.    IF FirstWord <= LastWord THEN
  1372.      IF Word$(FirstWord) <> "," THEN
  1373.        ExprFlags = VarLONG : GOSUB DumpExpr
  1374.        CALL CallLib (-1932)'SETMEM_L_
  1375.      END IF
  1376.    END IF
  1377.    IF FirstWord <= LastWord THEN GOSUB SkipKomma
  1378.    IF FirstWord <= LastWord THEN
  1379.      ExprFlags = VarLONG : GOSUB DumpExpr
  1380.      CALL CallLib (-1956)'SETSTACK_L_
  1381.    END IF
  1382.  
  1383. ' CLOSE [Dateinr[,Dateinr]...]
  1384.  ELSEIF Command$ = "CLOSE" THEN
  1385.    IF FirstWord > LastWord THEN
  1386.      CALL CallLib (-228)'CLOSE__
  1387.    ELSE
  1388.      ExpectKomma = FALSE
  1389.      WHILE FirstWord <= LastWord
  1390.        IF Word$(FirstWord) = "#" THEN GOSUB SkipOneWord
  1391.        IF ExpectKomma THEN
  1392.          GOSUB SkipKomma
  1393.        ELSE
  1394.          ExpectKomma = TRUE
  1395.        END IF
  1396.        ExprFlags = VarINT : GOSUB DumpExpr
  1397.        CALL CallLib (-222)'CLOSE_I_
  1398.      WEND
  1399.    END IF
  1400.  
  1401. ' CLS
  1402.  ELSEIF Command$ = "CLS" THEN
  1403.    CALL CallLib (-234)'CLS__
  1404.  
  1405. ' COLLISION ON / COLLISION OFF / COLLISION STOP
  1406.  ELSEIF Command$ = "COLLISION" THEN
  1407.    IF FirstWord <= LastWord AND Word$(FirstWord) = "ON" THEN
  1408.      GOSUB SkipOneWord
  1409.      CALL CallLib (-246)'COLLISIONON__
  1410.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "OFF" THEN
  1411.      GOSUB SkipOneWord
  1412.      CALL CallLib (-240)'COLLISIONOFF__
  1413.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "STOP" THEN
  1414.      GOSUB SkipOneWord
  1415.      CALL CallLib (-252)'COLLISIONSTOP__
  1416.    ELSE
  1417.      GOTO SyntaxError
  1418.    END IF
  1419.  
  1420. ' COLOR [Vordergrund][,Hintergrund]
  1421.  ELSEIF Command$ = "COLOR" THEN
  1422.    IF FirstWord <= LastWord AND Word$(FirstWord) <> "," THEN
  1423.      ExprFlags = VarINT : GOSUB DumpExpr
  1424.    ELSE
  1425.      CALL SubDumpVar ("0",VarINT+VarCONST,-1)
  1426.    END IF
  1427.    CALL CallLib (-264)'COLOR1_I_
  1428.    IF FirstWord <= LastWord THEN GOSUB SkipKomma
  1429.    IF FirstWord <= LastWord THEN
  1430.      ExprFlags = VarINT : GOSUB DumpExpr
  1431.    ELSE
  1432.      CALL SubDumpVar ("1",VarINT+VarCONST,-1)
  1433.    END IF
  1434.    CALL CallLib (-270)'COLOR2_I_
  1435.  
  1436. ' COMMON Varibale[,Variable]...
  1437.  ELSEIF Command$ = "COMMON" THEN
  1438.    GOTO NotCompilable
  1439.  
  1440. ' CONT
  1441.  ELSEIF Command$ = "CONT" THEN
  1442.    GOTO NotCompilable
  1443.  
  1444. ' DATA Konstante[,Konstante]...
  1445. ' DATA-Anweisung wird schon vorher behandelt
  1446.  ELSEIF Command$ = "DATA" THEN
  1447.  
  1448. ' DECLARE FUNCTION Name [(Parameterliste)] LIBRARY
  1449.  ELSEIF Command$ = "DECLARE" THEN
  1450.    GOTO NotImplemented
  1451.  
  1452. ' DEF FNName[(Arg[,Arg]...)] = Funktionsdefinition
  1453.  ELSEIF Command$ = "DEF" THEN
  1454.    GOTO NotImplemented
  1455.  
  1456. ' DEFDBL Buchst[-Buchst][,Buchst[-Buchst]]...
  1457.  ELSEIF Command$ = "DEFDBL" THEN
  1458.    DefType = VarDOUB : GOSUB HandleDefType
  1459.  
  1460. ' DEFINT Buchst[-Buchst][,Buchst[-Buchst]]...
  1461.  ELSEIF Command$ = "DEFINT" THEN
  1462.    DefType = VarINT : GOSUB HandleDefType
  1463.  
  1464. ' DEFLNG Buchst[-Buchst][,Buchst[-Buchst]]...
  1465.  ELSEIF Command$ = "DEFLNG" THEN
  1466.    DefType = VarLONG : GOSUB HandleDefType
  1467.  
  1468. ' DEFSNG Buchst[-Buchst][,Buchst[-Buchst]]...
  1469.  ELSEIF Command$ = "DEFSNG" THEN
  1470.    DefType = VarREAL : GOSUB HandleDefType
  1471.  
  1472. ' DEFSTR Buchst[-Buchst][,Buchst[-Buchst]]...
  1473.  ELSEIF Command$ = "DEFSTR" THEN
  1474.    DefType = VarTEXT : GOSUB HandleDefType
  1475.  
  1476. ' DELETE [Marke1][-[Marke2]]
  1477.  ELSEIF Command$ = "DELETE" THEN
  1478.    GOTO NotCompilable
  1479.  
  1480. ' DIM [SHARED] Var[(Ind)][,Var[(Ind)]]...
  1481.  ELSEIF Command$ = "DIM" THEN
  1482.    IsShared = FALSE
  1483.    IF FirstWord <= LastWord AND Word$(FirstWord) = "SHARED" THEN GOSUB SkipOneWord : IsShared = TRUE
  1484.    ExpectKomma = FALSE
  1485.    WHILE FirstWord <= LastWord OR ExpectKomma = FALSE
  1486.      IF ExpectKomma THEN
  1487.        GOSUB SkipKomma
  1488.      ELSE
  1489.        ExpectKomma = TRUE
  1490.      END IF
  1491.      CALL GetVarEnd (FirstWord,LastWord,TRUE)
  1492.      IF Ergebnis = -1 THEN EXIT SUB
  1493.      EndOfVar = Ergebnis
  1494.      IF FirstWord = EndOfVar THEN
  1495.        IF IsShared = FALSE THEN SyntaxError
  1496.        CALL GetVarNum (Word$(FirstWord),WordVarFlags(FirstWord),-1,0)
  1497.        GOSUB SkipOneWord
  1498.      ELSE
  1499.        IF IsShared THEN
  1500.          CALL GetVarNum (Word$(FirstWord),WordVarFlags(FirstWord),0,0)
  1501.        ELSE
  1502.          CALL GetVarNum (Word$(FirstWord),WordVarFlags(FirstWord),0,SubNumber)
  1503.        END IF
  1504.        VarNumber = Ergebnis
  1505.        CALL SubDumpField (FirstWord,EndOfVar)
  1506.        IF Ergebnis = FALSE THEN EXIT SUB
  1507.        IF VarSubNum(VarNumber) = 0 THEN
  1508.          IF Ergebnis = VarTEXT THEN
  1509.            CALL CallLib (-450)'DIMSHAREDTEXT_FP_
  1510.          ELSEIF Ergebnis = VarINT THEN
  1511.            CALL CallLib (-432)'DIMSHAREDINT_FP_
  1512.          ELSEIF Ergebnis = VarLONG THEN
  1513.            CALL CallLib (-438)'DIMSHAREDLONG_FP_
  1514.          ELSEIF Ergebnis = VarREAL THEN
  1515.            CALL CallLib (-444)'DIMSHAREDREAL_FP_
  1516.          ELSEIF Ergebnis = VarDOUB THEN
  1517.            CALL CallLib (-426)'DIMSHAREDDOUB_FP_
  1518.          END IF
  1519.        ELSE
  1520.          IF Ergebnis = VarTEXT THEN
  1521.            CALL CallLib (-420)'DIMTEXT_FP_
  1522.          ELSEIF Ergebnis = VarINT THEN
  1523.            CALL CallLib (-402)'DIMINT_FP_
  1524.          ELSEIF Ergebnis = VarLONG THEN
  1525.            CALL CallLib (-408)'DIMLONG_FP_
  1526.          ELSEIF Ergebnis = VarREAL THEN
  1527.            CALL CallLib (-414)'DIMREAL_FP_
  1528.          ELSEIF Ergebnis = VarDOUB THEN
  1529.            CALL CallLib (-396)'DIMDOUB_FP_
  1530.          END IF
  1531.        END IF
  1532.        FirstWord = EndOfVar+1
  1533.      END IF
  1534.    WEND
  1535.  
  1536. ' ELSE
  1537.  ELSEIF Command$ = "ELSE" THEN
  1538.    StackType = TypeIF : GOSUB Pull
  1539.    StackType = TypeIF : GOSUB Push
  1540.    CALL SubDumpLabel (Stack$(StackPointer,0))
  1541.    CALL CallLib (-840)'GOTO_Z_
  1542.    CALL SubSetLabel (Stack$(StackPointer,1))
  1543.    IF Ergebnis = FALSE THEN EXIT SUB
  1544.    CALL CreateLabel
  1545.    Stack$(StackPointer,1) = Ergebnis$
  1546.  
  1547. ' ELSEIF Ausdr THEN
  1548. ' das "THEN" wird nicht erwartet, es wurde schon zuvor entfernt
  1549.  ELSEIF Command$ = "ELSEIF" THEN
  1550.    StackType = TypeIF : GOSUB Pull
  1551.    StackType = TypeIF : GOSUB Push
  1552.    CALL SubDumpLabel (Stack$(StackPointer,0))
  1553.    CALL CallLib (-840)'GOTO_Z_
  1554.    CALL SubSetLabel (Stack$(StackPointer,1))
  1555.    IF Ergebnis = FALSE THEN EXIT SUB
  1556.    ExprFlags = VarINT : GOSUB DumpExpr
  1557.    CALL CreateLabel
  1558.    Stack$(StackPointer,1) = Ergebnis$
  1559.    CALL SubDumpLabel (Stack$(StackPointer,1))
  1560.    CALL CallLib (-912)'IF_IZ_
  1561.  
  1562. ' END / END SUB / END IF
  1563.  ELSEIF Command$ = "END" THEN
  1564.    IF FirstWord > LastWord THEN
  1565.      CALL CallLib (-36)'END__
  1566.    ELSEIF Word$(FirstWord) = "SUB" THEN
  1567.      GOSUB SkipOneWord
  1568.      IF SubNumber = 1 THEN CALL SomeError ("END SUB without SUB",CommandPos) : EXIT SUB
  1569.      CALL SubDumpLabel (LeaveSubLabel$)
  1570.      CALL CallLib (-840)'GOTO_Z_
  1571.      CALL SubSetLabel (SkipSubLabel$)
  1572.      SubNumber = 1
  1573.    ELSEIF Word$(FirstWord) = "IF" THEN
  1574.      GOSUB SkipOneWord
  1575.      StackType = TypeIF : GOSUB Pull
  1576.      CALL SubSetLabel (Stack$(StackPointer+1,0))
  1577.      IF Ergebnis = FALSE THEN EXIT SUB
  1578.      CALL SubSetLabel (Stack$(StackPointer+1,1))
  1579.      IF Ergebnis = FALSE THEN EXIT SUB
  1580.    ELSE
  1581.      GOTO SyntaxError
  1582.    END IF
  1583.  
  1584. ' ERASE Fledvar[,Feldvar]...
  1585.  ELSEIF Command$ = "ERASE" THEN
  1586.    ExpectKomma = FALSE
  1587.    WHILE FirstWord <= LastWord OR ExpectKomma = FALSE
  1588.      IF ExpectKomma THEN
  1589.        GOSUB SkipKomma
  1590.      ELSE
  1591.        ExpectKomma = TRUE
  1592.      END IF
  1593.      GOSUB DumpFieldPointer
  1594.      CALL CallLib (-564)'ERASE_f_
  1595.    WEND
  1596.  
  1597. ' ERROR n
  1598.  ELSEIF Command$ = "ERROR" THEN
  1599.    ExprFlags = VarLONG : GOSUB DumpExpr
  1600.    CALL CallLib (-576)'ERROR_L_
  1601.  
  1602. ' EXIT SUB
  1603.  ELSEIF Command$ = "EXIT" THEN
  1604.    IF FirstWord = LastWord AND Word$(FirstWord) = "SUB" THEN
  1605.      GOSUB SkipOneWord
  1606.      IF SubNumber = 1 THEN CALL SomeError ("EXIT SUB without SUB",CommandPos) : EXIT SUB
  1607.      CALL SubDumpLabel (LeaveSubLabel$)
  1608.      CALL CallLib (-840)'GOTO_Z_
  1609.    ELSE
  1610.      GOTO SyntaxError
  1611.    END IF
  1612.  
  1613. ' FIELD Dateinr,Länge AS Zeikettvar [,Länge AS Zeikettvar]...
  1614.  ELSEIF Command$ = "FIELD" THEN
  1615.    GOTO NotImplemented
  1616.  
  1617. ' FILES [Dateiangabe]
  1618.  ELSEIF Command$ = "FILES" THEN
  1619.    IF FirstWord > LastWord THEN
  1620.      CALL CallLib (-660)'FILES__
  1621.    ELSE
  1622.      ExprFlags = VarTEXT : GOSUB DumpExpr
  1623.      CALL CallLib (-654)'FILES_T_
  1624.    END IF
  1625.  
  1626. ' FOR Var = x TO y [STEP z]
  1627.  ELSEIF Command$ = "FOR" THEN
  1628.    IF FirstWord > LastWord THEN NeedSomethingError
  1629.    IF IsVar(FirstWord) = FALSE OR (WordVarFlags(FirstWord) AND VarCONST) <> 0 THEN CALL SomeError ("Expected a variable",WordPos(FirstWord)) : EXIT SUB
  1630.    IF WordVarFlags(FirstWord) AND VarTEXT THEN CALL SomeError ("No TEXT-variable allowed here",WordPos(FirstWord)) : EXIT SUB
  1631.    VarPointer = FirstWord
  1632.    GOSUB SkipOneWord
  1633.    IF FirstWord > LastWord OR Word$(FirstWord) <> "=" THEN CALL SomeError ("Expected '='",WordPos(FirstWord)) : EXIT SUB
  1634.    GOSUB SkipOneWord
  1635.    ExprFlags = WordVarFlags(VarPointer) : GOSUB DumpExpr
  1636.    CALL SubDumpSetSimpleVar (Word$(VarPointer),WordVarFlags(VarPointer),-1)
  1637.    IF FirstWord > LastWord THEN NeedSomethingError
  1638.    IF Word$(FirstWord) <> "TO" THEN SyntaxError
  1639.    GOSUB SkipOneWord
  1640.    ExprFlags = WordVarFlags(VarPointer) : GOSUB DumpExpr
  1641.    CALL SubDumpSetSimpleVar (Word$(VarPointer),WordVarFlags(VarPointer),-2)
  1642.    IF FirstWord > LastWord THEN
  1643.      CALL SubDumpVar ("1",WordVarFlags(VarPointer)+VarCONST,-1)
  1644.    ELSE
  1645.      IF Word$(FirstWord) <> "STEP" THEN SyntaxError
  1646.      GOSUB SkipOneWord
  1647.      ExprFlags = WordVarFlags(VarPointer) : GOSUB DumpExpr
  1648.    END IF
  1649.    CALL SubDumpSetSimpleVar (Word$(VarPointer),WordVarFlags(VarPointer),-3)
  1650.    StackType = TypeFOR : GOSUB Push
  1651.    CALL CreateLabel
  1652.    Stack$(StackPointer,0) = Ergebnis$
  1653.    Stack$(StackPointer,1) = Word$(VarPointer)
  1654.    CALL CreateLabel
  1655.    Stack$(StackPointer,2) = Ergebnis$
  1656.    CALL SubDumpLabel (Stack$(StackPointer,2))
  1657.    CALL CallLib (-840)'GOTO_Z_
  1658.    CALL SubSetLabel (Stack$(StackPointer,0))
  1659.    IF Ergebnis = FALSE THEN EXIT SUB
  1660.  
  1661. ' GET Dateinr,Satznr / GET (x1,y1)-(x2,y2), Fledvar [(Index[,Index...])]
  1662.  ELSEIF Command$ = "GET" THEN
  1663.    GOTO NotImplemented
  1664.  
  1665. ' GOSUB Marke
  1666.  ELSEIF Command$ = "GOSUB" THEN
  1667.    GOSUB DumpLabel
  1668.    CALL CallLib (-834)'GOSUB_Z_
  1669.  
  1670. ' GOTO Marke
  1671.  ELSEIF Command$ = "GOTO" THEN
  1672.    GOSUB DumpLabel
  1673.    CALL CallLib (-840)'GOTO_Z_
  1674.  
  1675. ' IF Ausdr THEN
  1676. ' das "THEN" wird nicht erwartet, es wurde schon zuvor entfernt
  1677.  ELSEIF Command$ = "IF" THEN
  1678.    ExprFlags = VarINT : GOSUB DumpExpr
  1679.    StackType = TypeIF : GOSUB Push
  1680.    CALL CreateLabel
  1681.    Stack$(StackPointer,0) = Ergebnis$
  1682.    CALL CreateLabel
  1683.    Stack$(StackPointer,1) = Ergebnis$
  1684.    CALL SubDumpLabel (Stack$(StackPointer,1))
  1685.    CALL CallLib (-912)'IF_IZ_
  1686.  
  1687. ' INPUT ["Text";] Var[,Var]...
  1688.  ELSEIF Command$ = "INPUT" THEN
  1689.    IF FirstWord <= LastWord AND Word$(FirstWord) = "#" THEN
  1690.      GOSUB SkipOneWord
  1691.      ExprFlags = VarINT : GOSUB DumpExpr
  1692.      GOSUB SkipKomma
  1693.      DidRead = FALSE
  1694.      WHILE FirstWord <= LastWord OR DidRead = FALSE
  1695.        IF DidRead THEN
  1696.          GOSUB SkipKomma
  1697.        ELSE
  1698.          DidRead = TRUE
  1699.        END IF
  1700.        CALL CallLib (-600)'FILEINPUT_I_IT
  1701.        StackFlags = VarTEXT : GOSUB DumpSetVar
  1702.      WEND
  1703.      CALL CallLib (-684)'FORGET_I_
  1704.    ELSE
  1705.      IF FirstWord <= LastWord AND LEFT$(Word$(FirstWord),1) = CHR$(34) THEN
  1706.        ExprFlags = VarTEXT : GOSUB DumpExpr
  1707.        CALL CallLib (-1782)'PRINT_T_
  1708.        IF FirstWord <= LastWord AND INSTR(";,",Word$(FirstWord)) THEN
  1709.          IF Word$(FirstWord) = ";" THEN CALL CallLib (-1740)'PRINTQMARK__
  1710.          GOSUB SkipOneWord
  1711.          GOSUB HandleInputLine
  1712.        ELSE
  1713.          GOTO SyntaxError
  1714.        END IF
  1715.      ELSE
  1716.        CALL CallLib (-1740)'PRINTQMARK__
  1717.        GOSUB HandleInputLine
  1718.      END IF
  1719.    END IF
  1720.  
  1721. ' KILL Dateiangabe
  1722.  ELSEIF Command$ = "KILL" THEN
  1723.    ExprFlags = VarTEXT : GOSUB DumpExpr
  1724.    CALL CallLib (-972)'KILL_T_
  1725.  
  1726. ' [LET] Var = Ausdruck
  1727.  ELSEIF Command$ = "LET" THEN
  1728.    SafeFirstWord = FirstWord
  1729.    GOSUB SkipOneVar
  1730.    IF FirstWord > LastWord OR Word$(FirstWord) <> "=" THEN CALL SomeError ("Expected '='",WordPos(FirstWord)) : EXIT SUB
  1731.    GOSUB SkipOneWord
  1732.    ExprFlags = VarTEXT OR VarINT OR VarLONG OR VarREAL OR VarDOUB : GOSUB DumpExpr
  1733.    FirstWord = SafeFirstWord
  1734.    StackFlags = Ergebnis : GOSUB DumpSetVar
  1735.    FirstWord = LastWord+1
  1736.  
  1737. ' LIBRARY "Dateiname" / LIBRARY CLOSE
  1738.  ELSEIF Command$ = "LIBRARY" THEN
  1739.    IF FirstWord <= LastWord AND Word$(FirstWord) = "CLOSE" THEN
  1740.      GOSUB SkipOneWord
  1741.      CALL CallLib (-1020)'LIBRARYCLOSE__
  1742.    ELSE
  1743.      ExprFlags = VarTEXT : GOSUB DumpExpr
  1744.      CALL CallLib (-1026)'LIBRARY_T_
  1745.    END IF
  1746.  
  1747. ' LINE INPUT #Dateinr,Zeikettenvar
  1748. ' LINE INPUT ["Text";]Zeikettvar
  1749. ' LINE [[STEP] (x1,y1)-[STEP] (x2,y2)[,Farbe][,B[F]]]
  1750.  ELSEIF Command$ = "LINE" THEN
  1751.    IF FirstWord <= LastWord AND Word$(FirstWord) = "INPUT" THEN
  1752.      GOSUB SkipOneWord
  1753.      IF FirstWord <= LastWord AND Word$(FirstWord) = "#" THEN
  1754.        GOSUB SkipOneWord
  1755.        ExprFlags = VarINT : GOSUB DumpExpr
  1756.        GOSUB SkipKomma
  1757.        CALL CallLib (-606)'FILELINEINPUT_I_T
  1758.        StackFlags = VarTEXT : GOSUB DumpSetVar
  1759.      ELSE
  1760.        IF FirstWord <= LastWord AND LEFT$(Word$(FirstWord),1) = CHR$(34) THEN
  1761.          ExprFlags = VarTEXT : GOSUB DumpExpr
  1762.          CALL CallLib (-1782)'PRINT_T_
  1763.          IF FirstWord > LastWord OR (Word$(FirstWord) <> ";" AND Word$(FirstWord) <> ",") THEN SyntaxError
  1764.          GOSUB SkipOneWord
  1765.        END IF
  1766.        CALL CallLib (-1044)'LINEINPUT__T
  1767.        StackFlags = VarTEXT : GOSUB DumpSetVar
  1768.      END IF
  1769.    ELSE
  1770.      IF FirstWord > LastWord OR Word$(FirstWord) <> "-" THEN
  1771.        GOSUB DumpGfxPoint
  1772.      ELSE
  1773.        CALL SubDumpVar ("0",VarINT+VarCONST,-1)
  1774.        CALL SubDumpVar ("0",VarINT+VarCONST,-1)
  1775.        CALL CallLib (-828)'GFXSTEP_II_II
  1776.      END IF
  1777.      IF FirstWord > LastWord OR Word$(FirstWord) <> "-" THEN SyntaxError
  1778.      GOSUB SkipOneWord
  1779.      GOSUB DumpGfxPoint
  1780.      IF FirstWord <= LastWord THEN GOSUB SkipKomma
  1781.      IF FirstWord > LastWord OR Word$(FirstWord) = "," THEN
  1782.        CALL CallLib (-714)'FRONTCOLOR__I
  1783.      ELSE
  1784.        ExprFlags = VarINT : GOSUB DumpExpr
  1785.      END IF
  1786.      IF FirstWord > LastWord THEN
  1787.        CALL CallLib (-1050)'LINE_IIIII_
  1788.      ELSE
  1789.        GOSUB SkipKomma
  1790.        IF FirstWord = LastWord AND Word$(FirstWord) = "B" THEN
  1791.          GOSUB SkipOneWord
  1792.          CALL CallLib (-1038)'LINEB_IIIII_
  1793.        ELSEIF FirstWord = LastWord AND Word$(FirstWord) = "BF" THEN
  1794.          GOSUB SkipOneWord
  1795.          CALL CallLib (-1032)'LINEBF_IIIII_
  1796.        ELSE
  1797.          GOTO SyntaxError
  1798.        END IF
  1799.      END IF
  1800.    END IF
  1801.  
  1802. ' LIST [Zeile1][-[Zeile2]][,Dateinang]
  1803.  ELSEIF Command$ = "LIST" THEN
  1804.    GOTO NotCompilable
  1805.  
  1806. ' LLIST [Zeile1][-[Zeile2]]
  1807.  ELSEIF Command$ = "LLIST" THEN
  1808.    GOTO NotCompilable
  1809.  
  1810. ' LOAD [Dateiangabe[,R]]
  1811.  ELSEIF Command$ = "LOAD" THEN
  1812.    GOTO NotCompilable
  1813.  
  1814. ' LOCATE [Zeile][,Spalte]
  1815.  ELSEIF Command$ = "LOCATE" THEN
  1816.    IF FirstWord <= LastWord THEN
  1817.      IF Word$(FirstWord) <> "," THEN
  1818.        ExprFlags = VarINT : GOSUB DumpExpr
  1819.        CALL CallLib (-1062)'LOCATEY_I_
  1820.      END IF
  1821.      IF FirstWord <= LastWord THEN GOSUB SkipKomma
  1822.      IF FirstWord <= LastWord THEN
  1823.        ExprFlags = VarINT : GOSUB DumpExpr
  1824.        CALL CallLib (-1056)'LOCATEX_I_
  1825.      END IF
  1826.    END IF
  1827.  
  1828. ' LPRINT [Liste von Ausdr][;]
  1829.  ELSEIF Command$ = "LPRINT" THEN
  1830.    SendReturn = TRUE
  1831.    WHILE FirstWord <= LastWord
  1832.      IF Word$(FirstWord) = ";" THEN
  1833.        GOSUB SkipOneWord
  1834.        SendReturn = FALSE
  1835.      END IF
  1836.      IF FirstWord <= LastWord AND Word$(FirstWord) = "," THEN
  1837.        GOSUB SkipOneWord
  1838.        CALL CallLib (-1104)'LPRINTTAB__
  1839.        SendReturn = FALSE
  1840.      END IF
  1841.      IF FirstWord <= LastWord THEN
  1842.        ExprFlags = VarTEXT OR VarINT OR VarLONG OR VarREAL OR VarDOUB : GOSUB DumpExpr
  1843.        IF Ergebnis = VarTEXT THEN
  1844.          CALL CallLib (-1134)'LPRINT_T_
  1845.        ELSEIF Ergebnis = VarINT THEN
  1846.          CALL CallLib (-1116)'LPRINT_I_
  1847.        ELSEIF Ergebnis = VarLONG THEN
  1848.          CALL CallLib (-1122)'LPRINT_L_
  1849.        ELSEIF Ergebnis = VarREAL THEN
  1850.          CALL CallLib (-1128)'LPRINT_R_
  1851.        ELSEIF Ergebnis = VarDOUB THEN
  1852.          CALL CallLib (-1110)'LPRINT_D_
  1853.        END IF
  1854.        SendReturn = TRUE
  1855.      END IF
  1856.    WEND
  1857.    IF SendReturn THEN CALL CallLib (-1098)'LPRINTRETURN__
  1858.  
  1859. ' MENU Kennung,Punkt,Status[,Titel] / MENU ON / MENU OFF / MENU STOP
  1860.  ELSEIF Command$ = "MENU" THEN
  1861.    IF FirstWord <= LastWord AND Word$(FirstWord) = "ON" THEN
  1862.      GOSUB SkipOneWord
  1863.      CALL CallLib (-1176)'MENUON__
  1864.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "OFF" THEN
  1865.      GOSUB SkipOneWord
  1866.      CALL CallLib (-1170)'MENUOFF__
  1867.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "STOP" THEN
  1868.      GOSUB SkipOneWord
  1869.      CALL CallLib (-1188)'MENUSTOP__
  1870.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "RESET" THEN
  1871.      GOSUB SkipOneWord
  1872.      CALL CallLib (-1182)'MENURESET__
  1873.    ELSE
  1874.      ExprFlags = VarINT : GOSUB DumpExpr
  1875.      GOSUB SkipKomma
  1876.      ExprFlags = VarINT : GOSUB DumpExpr
  1877.      GOSUB SkipKomma
  1878.      ExprFlags = VarINT : GOSUB DumpExpr
  1879.      IF FirstWord > LastWord THEN
  1880.        CALL CallLib (-1200)'MENU_III_
  1881.      ELSE
  1882.        GOSUB SkipKomma
  1883.        ExprFlags = VarTEXT : GOSUB DumpExpr
  1884.        CALL CallLib (-1194)'MENU_IIIT_
  1885.      END IF
  1886.    END IF
  1887.  
  1888. ' MERGE
  1889.  ELSEIF Command$ = "MERGE" THEN
  1890.    GOTO NotCompilable
  1891.  
  1892. ' MID$(v$,n[,m]) = x$
  1893.  ELSEIF Command$ = "MID$" THEN
  1894.    ThreePars = FALSE
  1895.    IF FirstWord > LastWord OR Word$(FirstWord) <> "(" THEN SyntaxError
  1896.    GOSUB SkipOneWord
  1897.    VarFlags = VarTEXT : GOSUB DumpVarPointer
  1898.    GOSUB SkipKomma
  1899.    ExprFlags = VarINT : GOSUB DumpExpr
  1900.    IF FirstWord <= LastWord AND Word$(FirstWord) = "," THEN
  1901.      GOSUB SkipKomma
  1902.      ThreePars = TRUE
  1903.      ExprFlags = VarINT : GOSUB DumpExpr
  1904.    END IF
  1905.    IF FirstWord > LastWord OR Word$(FirstWord) <> ")" THEN SyntaxError
  1906.    GOSUB SkipOneWord
  1907.    IF FirstWord > LastWord OR Word$(FirstWord) <> "=" THEN SyntaxError
  1908.    GOSUB SkipOneWord
  1909.    ExprFlags = VarTEXT : GOSUB DumpExpr
  1910.    IF ThreePars THEN
  1911.      CALL CallLib (-1938)'SETMID_tIIT_
  1912.    ELSE
  1913.      CALL CallLib (-1944)'SETMID_tIT_
  1914.    END IF
  1915.  
  1916. ' MOUSE ON / MOUSE OFF / MOUSE STOP
  1917.  ELSEIF Command$ = "MOUSE" THEN
  1918.    IF FirstWord <= LastWord AND Word$(FirstWord) = "ON" THEN
  1919.      GOSUB SkipOneWord
  1920.      CALL CallLib (-1266)'MOUSEON__
  1921.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "OFF" THEN
  1922.      GOSUB SkipOneWord
  1923.      CALL CallLib (-1260)'MOUSEOFF__
  1924.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "STOP" THEN
  1925.      GOSUB SkipOneWord
  1926.      CALL CallLib (-1272)'MOUSESTOP__
  1927.    ELSE
  1928.      GOTO SyntaxError
  1929.    END IF
  1930.  
  1931. ' NAME Dateiangabe AS Dateiname
  1932.  ELSEIF Command$ = "NAME" THEN
  1933.    ExprFlags = VarTEXT : GOSUB DumpExpr
  1934.    IF FirstWord > LastWord OR Word$(FirstWord) <> "AS" THEN SyntaxError
  1935.    GOSUB SkipOneWord
  1936.    ExprFlags = VarTEXT : GOSUB DumpExpr
  1937.    CALL CallLib (-1308)'NAME_TT_
  1938.  
  1939. ' Damit IF ... THEN nicht zu lang wird
  1940.  ELSE
  1941.    NotFound = NotFound+1
  1942.  END IF
  1943.  
  1944. ' NEW
  1945.  IF Command$ = "NEW" THEN
  1946.    GOTO NotCompilable
  1947.  
  1948. ' NEXT [Var][,Var]...
  1949.  ELSEIF Command$ = "NEXT" THEN
  1950.    ExpectKomma = FALSE
  1951.    WHILE FirstWord <= LastWord OR ExpectKomma = FALSE
  1952.      IF ExpectKomma THEN
  1953.        GOSUB SkipKomma
  1954.      ELSE
  1955.        ExpectKomma = TRUE
  1956.      END IF
  1957.      StackType = TypeFOR : GOSUB Pull
  1958.      IF FirstWord <= LastWord AND Word$(FirstWord) <> "," THEN
  1959.        IF IsVar(FirstWord) = FALSE OR (WordVarFlags(FirstWord) AND (VarCONST OR VarTEXT)) <> 0 THEN CALL SomeError ("Expected numeric variable",WordPos(FirstWord)) : EXIT SUB
  1960.        IF Word$(FirstWord) <> Stack$(StackPointer+1,1) THEN CALL SomeError ("Not the same variable like that in the FOR-command",WordPos(FirstWord)) : EXIT SUB
  1961.        GOSUB SkipOneWord
  1962.      END IF
  1963.      CALL GetVarFlags (Stack$(StackPointer+1,1))
  1964.      CountVarFlags = Ergebnis
  1965. ' Zählvariable erhöhen
  1966.      CALL SubDumpVar (Stack$(StackPointer+1,1),CountVarFlags,-1)
  1967.      CALL SubDumpVar (Stack$(StackPointer+1,1),CountVarFlags,-3)
  1968.      IF CountVarFlags = VarINT THEN
  1969.        CALL CallLib (-72)'ADD_II_I
  1970.      ELSEIF CountVarFlags = VarLONG THEN
  1971.        CALL CallLib (-78)'ADD_LL_L
  1972.      ELSEIF CountVarFlags = VarREAL THEN
  1973.        CALL CallLib (-84)'ADD_RR_R
  1974.      ELSEIF CountVarFlags = VarDOUB THEN
  1975.        CALL CallLib (-66)'ADD_DD_D
  1976.      END IF
  1977.      CALL SubDumpSetSimpleVar (Stack$(StackPointer+1,1),CountVarFlags,-1)
  1978. ' Label fuer FOR setzen
  1979.      CALL SubSetLabel (Stack$(StackPointer+1,2))
  1980.      IF Ergebnis = FALSE THEN EXIT SUB
  1981. ' NEXT-Abfrage
  1982.      CALL SubDumpVar (Stack$(StackPointer+1,1),CountVarFlags,-1)
  1983.      CALL SubDumpVar (Stack$(StackPointer+1,1),CountVarFlags,-2)
  1984.      CALL SubDumpVar (Stack$(StackPointer+1,1),CountVarFlags,-3)
  1985.      CALL SubDumpLabel (Stack$(StackPointer+1,0))
  1986.      IF CountVarFlags = VarINT THEN
  1987.        CALL CallLib (-1344)'NEXT_IIIZ_
  1988.      ELSEIF CountVarFlags = VarLONG THEN
  1989.        CALL CallLib (-1350)'NEXT_LLLZ_
  1990.      ELSEIF CountVarFlags = VarREAL THEN
  1991.        CALL CallLib (-1356)'NEXT_RRRZ_
  1992.      ELSEIF CountVarFlags = VarDOUB THEN
  1993.        CALL CallLib (-1338)'NEXT_DDDZ_
  1994.      END IF
  1995.    WEND
  1996.  
  1997. ' OBJECT.AX Objekt,Wert
  1998.  ELSEIF Command$ = "OBJECT.AX" THEN
  1999.    ExprFlags = VarINT : GOSUB DumpExpr
  2000.    GOSUB SkipKomma
  2001.    ExprFlags = VarINT : GOSUB DumpExpr
  2002.    CALL CallLib (-1404)'OBJECT.AX_II_
  2003.  
  2004. ' OBJECT.AY Objekt,Wert
  2005.  ELSEIF Command$ = "OBJECT.AY" THEN
  2006.    ExprFlags = VarINT : GOSUB DumpExpr
  2007.    GOSUB SkipKomma
  2008.    ExprFlags = VarINT : GOSUB DumpExpr
  2009.    CALL CallLib (-1410)'OBJECT.AY_II_
  2010.  
  2011. ' OBJECT.CLIP (x1,y1)-(x2,y2)
  2012.  ELSEIF Command$ = "OBJECT.CLIP" THEN
  2013.    GOSUB DumpGfxPoint
  2014.    IF FirstWord > LastWord OR Word$(FirstWord) <> "-" THEN SyntaxError
  2015.    GOSUB DumpGfxPoint
  2016.    CALL CallLib (-1416)'OBJECT.CLIP_IIII_
  2017.  
  2018. ' OBJECT.CLOSE [Object[,Objekt...]]
  2019.  ELSEIF Command$ = "OBJECT.CLOSE" THEN
  2020.    IF FirstWord > LastWord THEN
  2021.      CALL CallLib (-1428)'OBJECT.CLOSE__
  2022.    ELSE
  2023.      ExpectKomma = FALSE
  2024.      WHILE FirstWord <= LastWord
  2025.        IF ExpectKomma THEN
  2026.          GOSUB SkipKomma
  2027.        ELSE
  2028.          ExpectKomma = TRUE
  2029.        END IF
  2030.        ExprFlags = VarINT : GOSUB DumpExpr
  2031.        CALL CallLib (-1422)'OBJECT.CLOSE_I_
  2032.      WEND
  2033.    END IF
  2034.  
  2035. ' OBJECT.HIT Objekt[,[Selbst][,[Fremd]]]
  2036.  ELSEIF Command$ = "OBJECT.HIT" THEN
  2037.    ExprFlags = VarINT : GOSUB DumpExpr
  2038.    GOSUB SkipKomma
  2039.    IF FirstWord <= LastWord AND Word$(FirstWord) <> "," THEN
  2040.      ExprFlags = VarLONG : GOSUB DumpExpr
  2041.      CALL CallLib (-1434)'OBJECT.HIT1_II_I
  2042.    END IF
  2043.    IF FirstWord <= LastWord THEN GOSUB SkipKomma
  2044.    IF FirstWord <= LastWord THEN
  2045.      ExprFlags = VarLONG : GOSUB DumpExpr
  2046.      CALL CallLib (-1440)'OBJECT.HIT2_II_I
  2047.    END IF
  2048.    CALL CallLib (-684)'FORGET_I_
  2049.  
  2050. ' OBJECT.OFF [Objekt[,Objekt...]]
  2051.  ELSEIF Command$ = "OBJECT.OFF" THEN
  2052.    IF FirstWord > LastWord THEN
  2053.      CALL CallLib (-1452)'OBJECT.OFF__
  2054.    ELSE
  2055.      ExpectKomma = FALSE
  2056.      WHILE FirstWord <= LastWord
  2057.        IF ExpectKomma THEN
  2058.          GOSUB SkipKomma
  2059.        ELSE
  2060.          ExpectKomma = TRUE
  2061.        END IF
  2062.        ExprFlags = VarINT : GOSUB DumpExpr
  2063.        CALL CallLib (-1446)'OBJECT.OFF_I_
  2064.      WEND
  2065.    END IF
  2066.  
  2067. ' OBJECT.ON [Objekt[,Objekt...]]
  2068.  ELSEIF Command$ = "OBJECT.ON" THEN
  2069.    IF FirstWord > LastWord THEN
  2070.      CALL CallLib (-1464)'OBJECT.ON__
  2071.    ELSE
  2072.      ExpectKomma = FALSE
  2073.      WHILE FirstWord <= LastWord
  2074.        IF ExpectKomma THEN
  2075.          GOSUB SkipKomma
  2076.        ELSE
  2077.          ExpectKomma = TRUE
  2078.        END IF
  2079.        ExprFlags = VarINT : GOSUB DumpExpr
  2080.        CALL CallLib (-1458)'OBJECT.ON_I_
  2081.      WEND
  2082.    END IF
  2083.  
  2084. ' OBJECT.PLANES Objekt[,[Bitebene][,[Ebene-Ein-Aus]]]
  2085.  ELSEIF Command$ = "OBJECT.PLANES" THEN
  2086.    ExprFlags = VarINT : GOSUB DumpExpr
  2087.    GOSUB SkipKomma
  2088.    IF FirstWord <= LastWord AND Word$(FirstWord) <> "," THEN
  2089.      ExprFlags = VarINT : GOSUB DumpExpr
  2090.      CALL CallLib (-1470)'OBJECT.PLANES1_II_I
  2091.    END IF
  2092.    IF FirstWord <= LastWord THEN GOSUB SkipKomma
  2093.    IF FirstWord <= LastWord THEN
  2094.      ExprFlags = VarINT : GOSUB DumpExpr
  2095.      CALL CallLib (-1476)'OBJECT.PLANES2_II_I
  2096.    END IF
  2097.    CALL CallLib (-684)'FORGET_I_
  2098.  
  2099. ' OBJECT.PRIORITY Objekt,Prior
  2100.  ELSEIF Command$ = "OBJECT.PRIORITY" THEN
  2101.    ExprFlags = VarINT : GOSUB DumpExpr
  2102.    GOSUB SkipKomma
  2103.    ExprFlags = VarINT : GOSUB DumpExpr
  2104.    CALL CallLib (-1482)'OBJECT.PRIORITY_II_
  2105.  
  2106. ' OBJECT.SHAPE Objekt,Definition / OBJECT.SHAPE Objekt1,Objekt2
  2107.  ELSEIF Command$ = "OBJECT.SHAPE" THEN
  2108.    ExprFlags = VarINT : GOSUB DumpExpr
  2109.    GOSUB SkipKomma
  2110.    ExprFlags = VarINT OR VarTEXT : GOSUB DumpExpr
  2111.    IF Ergebnis = VarINT THEN
  2112.      CALL CallLib (-1488)'OBJECT.SHAPE_II_
  2113.    ELSE
  2114.      CALL CallLib (-1494)'OBJECT.SHAPE_IT_
  2115.    END IF
  2116.  
  2117. ' OBJECT.START [Objekt[,Objekt...]]
  2118.  ELSEIF Command$ = "OBJECT.START" THEN
  2119.    IF FirstWord > LastWord THEN
  2120.      CALL CallLib (-1506)'OBJECT.START__
  2121.    ELSE
  2122.      ExpectKomma = FALSE
  2123.      WHILE FirstWord <= LastWord
  2124.        IF ExpectKomma THEN
  2125.          GOSUB SkipKomma
  2126.        ELSE
  2127.          ExpectKomma = TRUE
  2128.        END IF
  2129.        ExprFlags = VarINT : GOSUB DumpExpr
  2130.        CALL CallLib (-1500)'OBJECT.START_I_
  2131.      WEND
  2132.    END IF
  2133.  
  2134. ' OBJECT.STOP [Objekt[,Objekt...]]
  2135.  ELSEIF Command$ = "OBJECT.STOP" THEN
  2136.    IF FirstWord > LastWord THEN
  2137.      CALL CallLib (-1518)'OBJECT.STOP__
  2138.    ELSE
  2139.      ExpectKomma = FALSE
  2140.      WHILE FirstWord <= LastWord
  2141.        IF ExpectKomma THEN
  2142.          GOSUB SkipKomma
  2143.        ELSE
  2144.          ExpectKomma = TRUE
  2145.        END IF
  2146.        ExprFlags = VarINT : GOSUB DumpExpr
  2147.        CALL CallLib (-1512)'OBJECT.STOP_I_
  2148.      WEND
  2149.    END IF
  2150.  
  2151. ' OBJECT.VX Objekt,Geschw
  2152.  ELSEIF Command$ = "OBJECT.VX" THEN
  2153.    ExprFlags = VarINT : GOSUB DumpExpr
  2154.    GOSUB SkipKomma
  2155.    ExprFlags = VarINT : GOSUB DumpExpr
  2156.    CALL CallLib (-1524)'OBJECT.VX_II_
  2157.  
  2158. ' OBJECT.VY Objekt,Geschw
  2159.  ELSEIF Command$ = "OBJECT.VY" THEN
  2160.    ExprFlags = VarINT : GOSUB DumpExpr
  2161.    GOSUB SkipKomma
  2162.    ExprFlags = VarINT : GOSUB DumpExpr
  2163.    CALL CallLib (-1536)'OBJECT.VY_II_
  2164.  
  2165. ' OBJECT.X Objekt,x
  2166.  ELSEIF Command$ = "OBJECT.X" THEN
  2167.    ExprFlags = VarINT : GOSUB DumpExpr
  2168.    GOSUB SkipKomma
  2169.    ExprFlags = VarINT : GOSUB DumpExpr
  2170.    CALL CallLib (-1548)'OBJECT.X_II_
  2171.  
  2172. ' OBJECT.Y Objekt,y
  2173.  ELSEIF Command$ = "OBJECT.Y" THEN
  2174.    ExprFlags = VarINT : GOSUB DumpExpr
  2175.    GOSUB SkipKomma
  2176.    ExprFlags = VarINT : GOSUB DumpExpr
  2177.    CALL CallLib (-1554)'OBJECT.Y_II_
  2178.  
  2179.  ELSEIF Command$ = "ON" THEN
  2180.  
  2181. ' ON BREAK GOSUB Marke
  2182.    IF FirstWord <= LastWord AND Word$(FirstWord) = "BREAK" THEN
  2183.      GOSUB SkipOneWord
  2184.      IF FirstWord > LastWord OR Word$(FirstWord) <> "GOSUB" THEN SyntaxError
  2185.      GOSUB SkipOneWord
  2186.      GOSUB DumpLabel
  2187.      CALL CallLib (-1566)'ONBREAKGOSUB_Z_
  2188.  
  2189. ' ON COLLISION GOSUB Marke
  2190.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "COLLISION" THEN
  2191.      GOSUB SkipOneWord
  2192.      IF FirstWord > LastWord OR Word$(FirstWord) <> "GOSUB" THEN SyntaxError
  2193.      GOSUB SkipOneWord
  2194.      GOSUB DumpLabel
  2195.      CALL CallLib (-1572)'ONCOLLISIONGOSUB_Z_
  2196.  
  2197. ' ON ERROR GOTO Marke
  2198.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "ERROR" THEN
  2199.      GOSUB SkipOneWord
  2200.      IF FirstWord > LastWord OR Word$(FirstWord) <> "GOTO" THEN SyntaxError
  2201.      GOSUB SkipOneWord
  2202.      GOSUB DumpLabel
  2203.      CALL CallLib (-1578)'ONERRORGOTO_Z_
  2204.  
  2205. ' ON MENU GOSUB Marke
  2206.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "MENU" THEN
  2207.      GOSUB SkipOneWord
  2208.      IF FirstWord > LastWord OR Word$(FirstWord) <> "GOSUB" THEN SyntaxError
  2209.      GOSUB SkipOneWord
  2210.      GOSUB DumpLabel
  2211.      CALL CallLib (-1596)'ONMENUGOSUB_Z_
  2212.  
  2213. ' ON MOUSE GOSUB Marke
  2214.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "MOUSE" THEN
  2215.      GOSUB SkipOneWord
  2216.      IF FirstWord > LastWord OR Word$(FirstWord) <> "GOSUB" THEN SyntaxError
  2217.      GOSUB SkipOneWord
  2218.      GOSUB DumpLabel
  2219.      CALL CallLib (-1602)'ONMOUSEGOSUB_Z_
  2220.  
  2221. ' ON TIMER (n) GOSUB Marke
  2222.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "TIMER" THEN
  2223.      GOSUB SkipOneWord
  2224.      ExprFlags = VarINT : GOSUB DumpExpr
  2225.      IF FirstWord > LastWord OR Word$(FirstWord) <> "GOSUB" THEN SyntaxError
  2226.      GOSUB SkipOneWord
  2227.      GOSUB DumpLabel
  2228.      CALL CallLib (-1608)'ONTIMERGOSUB_IZ_
  2229.  
  2230. ' ON ... GOSUB / GOTO Marke[,Marke]...
  2231.    ELSE
  2232.      CALL SubDumpVar ("0",VarINT+VarCONST,-1)
  2233.      ExprFlags = VarINT : GOSUB DumpExpr
  2234.      IF FirstWord > LastWord OR (Word$(FirstWord) <> "GOSUB" AND Word$(FirstWord) <> "GOTO") THEN CALL SomeError ("Expected GOTO or GOSUB",WordPos(FirstWord)) : EXIT SUB
  2235.      IsGoto = Word$(FirstWord) = "GOTO"
  2236.      GOSUB SkipOneWord
  2237.      ExpectKomma = FALSE
  2238.      WHILE FirstWord <= LastWord OR ExpectKomma = FALSE
  2239.        IF ExpectKomma THEN
  2240.          GOSUB SkipKomma
  2241.        ELSE
  2242.          ExpectKomma = TRUE
  2243.        END IF
  2244.        IF FirstWord > LastWord THEN NeedSomethingError
  2245.        CALL CouldThisBeALabel (FirstWord)
  2246.        IF Ergebnis = FALSE THEN CALL SomeError ("Expected a label",WordPos(FirstWord)) : EXIT SUB
  2247.        CALL SubDumpLabel (Word$(FirstWord))
  2248.        GOSUB SkipOneWord
  2249.        IF IsGoto THEN
  2250.          CALL CallLib (-1590)'ONGOTO_IIZ_II
  2251.        ELSE
  2252.          CALL CallLib (-1584)'ONGOSUB_IIZ_II
  2253.        END IF
  2254.      WEND
  2255.      CALL CallLib (-684)'FORGET_I_
  2256.      CALL CallLib (-684)'FORGET_I_
  2257.   END IF
  2258.  
  2259. ' OPEN Dateinang FOR Modus1 AS Dateinr
  2260.  ELSEIF Command$ = "OPEN" THEN
  2261.    ExprFlags =  VarTEXT : GOSUB DumpExpr
  2262.    OpenModus = 0
  2263.    IF FirstWord <= LastWord AND Word$(FirstWord) = "FOR" THEN
  2264.      GOSUB SkipOneWord
  2265.      IF FirstWord <= LastWord AND Word$(FirstWord) = "OUTPUT" THEN
  2266.        GOSUB SkipOneWord
  2267.        OpenModus = 1
  2268.      ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "APPEND" THEN
  2269.        GOSUB SkipOneWord
  2270.        OpenModus = 2
  2271.      ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "INPUT" THEN
  2272.        GOSUB SkipOneWord
  2273.        OpenModus = 3
  2274.      ELSE
  2275.        GOTO SyntaxError
  2276.      END IF
  2277.    END IF
  2278.    IF FirstWord > LastWord OR Word$(FirstWord) <> "AS" THEN SyntaxError
  2279.    GOSUB SkipOneWord
  2280.    IF FirstWord <= LastWord AND Word$(FirstWord) = "#" THEN GOSUB SkipOneWord
  2281.    ExprFlags = VarINT : GOSUB DumpExpr
  2282.    IF OpenModus = 0 THEN
  2283.      CALL CallLib (-1632)'OPENREADWRITE_TI_
  2284.    ELSEIF OpenModus = 1 THEN
  2285.      CALL CallLib (-1626)'OPENOUTPUT_TI_
  2286.    ELSEIF OpenModus = 2 THEN
  2287.      CALL CallLib (-1614)'OPENAPPEND_TI_
  2288.    ELSEIF OpenModus = 3 THEN
  2289.      CALL CallLib (-1620)'OPENINPUT_TI_
  2290.    END IF
  2291.  
  2292. ' OPTION BASE n
  2293.  ELSEIF Command$ = "OPTION" THEN
  2294.    IF FirstWord > LastWord OR Word$(FirstWord) <> "BASE" THEN SyntaxError
  2295.    GOSUB SkipOneWord
  2296.    ExprFlags = VarINT : GOSUB DumpExpr
  2297.    GOTO NotImplemented
  2298.  
  2299. ' PAINT [STEP](x,y) [,Farbe[,Rand]]
  2300.  ELSEIF Command$ = "PAINT" THEN
  2301.    GOSUB DumpGfxPoint
  2302.    IF FirstWord <= LastWord THEN GOSUB SkipKomma
  2303.    IF FirstWord <= LastWord THEN
  2304.      ExprFlags = VarINT : GOSUB DumpExpr
  2305.    ELSE
  2306.      CALL CallLib (-720)'GETCOLOR0__I
  2307.    END IF
  2308.    IF FirstWord <= LastWord THEN GOSUB SkipKomma
  2309.    IF FirstWord <= LastWord THEN
  2310.      ExprFlags = VarINT : GOSUB DumpExpr
  2311.    ELSE
  2312.      CALL CallLib (-486)'DOUBLE_I_II
  2313.    END IF
  2314.    CALL CallLib (-1650)'PAINT_IIII_
  2315.  
  2316. ' PALETTE Farbe,Rot,Grn,Blau
  2317.  ELSEIF Command$ = "PALETTE" THEN
  2318.    ExprFlags = VarINT : GOSUB DumpExpr
  2319.    GOSUB SkipKomma
  2320.    ExprFlags = VarREAL : GOSUB DumpExpr
  2321.    GOSUB SkipKomma
  2322.    ExprFlags = VarREAL : GOSUB DumpExpr
  2323.    GOSUB SkipKomma
  2324.    ExprFlags = VarREAL : GOSUB DumpExpr
  2325.    CALL CallLib (-1656)'PALETTE_IRRR_
  2326.  
  2327. ' PATTERN [Lmuster][,Fmuster]
  2328.  ELSEIF Command$ = "PATTERN" THEN
  2329.    IF FirstWord <= LastWord THEN
  2330.      ExprFlags = VarLONG : GOSUB DumpExpr
  2331.      CALL CallLib (-1662)'PATTERN1_L_
  2332.    END IF
  2333.    IF FirstWord <= LastWord THEN GOSUB SkipKomma
  2334.    IF FirstWord <= LastWord THEN
  2335.      ExprFlags = VarLONG : GOSUB DumpExpr
  2336.      CALL CallLib (-1668)'PATTERN2_L_
  2337.    END IF
  2338.  
  2339. ' POKE Adresse,m
  2340.  ELSEIF Command$ = "POKE" THEN
  2341.    ExprFlags = VarLONG : GOSUB DumpExpr
  2342.    GOSUB SkipKomma
  2343.    ExprFlags = VarINT : GOSUB DumpExpr
  2344.    CALL CallLib (-1710)'POKE_LI_
  2345.  
  2346. ' POKEL Adresse,m
  2347.  ELSEIF Command$ = "POKEL" THEN
  2348.    ExprFlags = VarLONG : GOSUB DumpExpr
  2349.    GOSUB SkipKomma
  2350.    ExprFlags = VarLONG : GOSUB DumpExpr
  2351.    CALL CallLib (-1698)'POKEL_LL_
  2352.  
  2353. ' POKEW Adresse,m
  2354.  ELSEIF Command$ = "POKEW" THEN
  2355.    ExprFlags = VarLONG : GOSUB DumpExpr
  2356.    GOSUB SkipKomma
  2357.    ExprFlags = VarINT : GOSUB DumpExpr
  2358.    CALL CallLib (-1704)'POKEW_LI_
  2359.  
  2360. ' PRESET [STEP] (x,y)[,Farbe]
  2361.  ELSEIF Command$ = "PRESET" THEN
  2362.    GOSUB DumpGfxPoint
  2363.    IF FirstWord <= LastWord THEN GOSUB SkipKomma
  2364.    IF FirstWord <= LastWord THEN
  2365.      ExprFlags = VarINT : GOSUB DumpExpr
  2366.    ELSE
  2367.      CALL CallLib (-720)'GETCOLOR0__I
  2368.    END IF
  2369.    CALL CallLib (-1734)'PRESET_III_
  2370.  
  2371. ' PRINT [List von Ausdr]
  2372.  ELSEIF Command$ = "PRINT" THEN
  2373.    DoPrintToFile = FirstWord <= LastWord AND Word$(FirstWord) = "#"
  2374.    IF DoPrintToFile THEN
  2375.      GOSUB SkipOneWord
  2376.      ExprFlags = VarINT : GOSUB DumpExpr
  2377.      GOSUB SkipKomma
  2378.    END IF
  2379.    SendReturn = TRUE
  2380.    WHILE FirstWord <= LastWord
  2381.      IF Word$(FirstWord) = ";" THEN
  2382.        GOSUB SkipOneWord
  2383.        SendReturn = FALSE
  2384.      ELSEIF Word$(FirstWord) = "," THEN
  2385.        GOSUB SkipOneWord
  2386.        IF DoPrintToFile THEN
  2387.          CALL CallLib (-618)'FILEPRINTTAB_I_I
  2388.        ELSE
  2389.          CALL CallLib (-1752)'PRINTTAB__
  2390.        END IF
  2391.        SendReturn = FALSE
  2392.      ELSE
  2393.        ExprFlags = VarTEXT OR VarINT OR VarLONG OR VarREAL OR VarDOUB : GOSUB DumpExpr
  2394.        IF DoPrintToFile THEN
  2395.          IF Ergebnis = VarTEXT THEN
  2396.            CALL CallLib (-648)'FILEPRINT_IT_I
  2397.          ELSEIF Ergebnis = VarINT THEN
  2398.            CALL CallLib (-630)'FILEPRINT_II_I
  2399.          ELSEIF Ergebnis = VarLONG THEN
  2400.            CALL CallLib (-636)'FILEPRINT_IL_I
  2401.          ELSEIF Ergebnis = VarREAL THEN
  2402.            CALL CallLib (-642)'FILEPRINT_IR_I
  2403.          ELSEIF Ergebnis = VarDOUB THEN
  2404.            CALL CallLib (-624)'FILEPRINT_ID_I
  2405.          END IF
  2406.        ELSE
  2407.          IF Ergebnis = VarTEXT THEN
  2408.            CALL CallLib (-1782)'PRINT_T_
  2409.          ELSEIF Ergebnis = VarINT THEN
  2410.            CALL CallLib (-1764)'PRINT_I_
  2411.          ELSEIF Ergebnis = VarLONG THEN
  2412.            CALL CallLib (-1770)'PRINT_L_
  2413.          ELSEIF Ergebnis = VarREAL THEN
  2414.            CALL CallLib (-1776)'PRINT_R_
  2415.          ELSEIF Ergebnis = VarDOUB THEN
  2416.            CALL CallLib (-1758)'PRINT_D_
  2417.          END IF
  2418.        END IF
  2419.        SendReturn = TRUE
  2420.      END IF
  2421.    WEND
  2422.    IF SendReturn THEN
  2423.      IF DoPrintToFile THEN
  2424.        CALL CallLib (-612)'FILEPRINTRETURN_I_I
  2425.      ELSE
  2426.        CALL CallLib (-1746)'PRINTRETURN__
  2427.      END IF
  2428.    END IF
  2429.    IF DoPrintToFile THEN CALL CallLib (-684)'FORGET_I_
  2430.  
  2431. ' PSET [STEP] (x,y)[,Farbe]
  2432.  ELSEIF Command$ = "PSET" THEN
  2433.    GOSUB DumpGfxPoint
  2434.    IF FirstWord <= LastWord THEN GOSUB SkipKomma
  2435.    IF FirstWord <= LastWord THEN
  2436.      ExprFlags = VarINT : GOSUB DumpExpr
  2437.    ELSE
  2438.      CALL CallLib (-720)'GETCOLOR0__I
  2439.    END IF
  2440.    CALL CallLib (-1788)'PSET_III_
  2441.  
  2442. ' PUT [#]Dateinr[,Satznr]
  2443.  ELSEIF Command$ = "PUT" THEN
  2444.    GOTO NotImplemented
  2445.  
  2446. ' RANDOMIZE [n]
  2447.  ELSEIF Command$ = "RANDOMIZE" THEN
  2448.    IF FirstWord > LastWord THEN
  2449.      CALL CallLib (-1800)'RANDOMIZE__
  2450.    ELSE
  2451.      ExprFlags = VarINT : GOSUB DumpExpr
  2452.      CALL CallLib (-1794)'RANDOMIZE_I_
  2453.    END IF
  2454.  
  2455. ' READ Var[,Var]...
  2456.  ELSEIF Command$ = "READ" THEN
  2457.    ExpectKomma = FALSE
  2458.    WHILE FirstWord <= LastWord OR ExpectKomma = FALSE
  2459.      IF ExpectKomma THEN
  2460.        GOSUB SkipKomma
  2461.      ELSE
  2462.        ExpectKomma = TRUE
  2463.      END IF
  2464.      CALL CallLib (-1806)'READ__T
  2465.      CALL GetVarEnd (FirstWord,LastWord,TRUE)
  2466.      IF Ergebnis = -1 THEN EXIT SUB
  2467.      IF WordVarFlags(FirstWord) = VarTEXT THEN
  2468.      ELSEIF WordVarFlags(FirstWord) = VarINT THEN
  2469.        CALL CallLib (-2232)'VAL_T_D
  2470.        CALL CallLib (-276)'CONVERT_D_I
  2471.      ELSEIF WordVarFlags(FirstWord) = VarLONG THEN
  2472.        CALL CallLib (-2232)'VAL_T_D
  2473.        CALL CallLib (-282)'CONVERT_D_L
  2474.      ELSEIF WordVarFlags(FirstWord) = VarREAL THEN
  2475.        CALL CallLib (-2232)'VAL_T_D
  2476.        CALL CallLib (-288)'CONVERT_D_R
  2477.      ELSEIF WordVarFlags(FirstWord) = VarDOUB THEN
  2478.        CALL CallLib (-2232)'VAL_T_D
  2479.      END IF
  2480.      StackFlags = WordVarFlags(FirstWord) : GOSUB DumpSetVar
  2481.    WEND
  2482.  
  2483. ' REM Kommentartext
  2484. ' wurde schon vorher abgefangen
  2485.  
  2486. ' RESTORE [Marke]
  2487.  ELSEIF Command$ = "RESTORE" THEN
  2488.    IF FirstWord > LastWord THEN
  2489.      CALL CallLib (-1818)'RESTORE__
  2490.    ELSE
  2491.      IF FirstWord > LastWord THEN CALL SomeError ("Expected a label",WordPos(FirstWord)) : EXIT SUB
  2492.      CALL CouldThisBeALabel (FirstWord)
  2493.      IF Ergebnis = FALSE THEN CALL SomeError ("Expected a label",WordPos(FirstWord)) : EXIT SUB
  2494.      CALL GetLabelNum (Word$(FirstWord),FALSE)
  2495.      IF Ergebnis = -1 THEN EXIT SUB
  2496.      IF Pass > 1 THEN
  2497.        a = 0
  2498.        WHILE a <= NumData AND DataLine(a) < LabelLine(Ergebnis)
  2499.          a = a+1
  2500.        WEND
  2501.        CALL SubIntToString (a)
  2502.        CALL SubDumpVar (Ergebnis$,VarINT+VarCONST,-1)
  2503.      END IF
  2504.      CALL CallLib (-1812)'RESTORE_I_
  2505.      GOSUB SkipOneWord
  2506.   END IF
  2507.  
  2508. ' RESUME [0] / RESUME NEXT / RESUME Marke
  2509.  ELSEIF Command$ = "RESUME" THEN
  2510.    IF FirstWord > LastWord THEN
  2511.      CALL CallLib (-1836)'RESUME__
  2512.    ELSE
  2513.      IF FirstWord <= LastWord AND Word$(FirstWord) = "NEXT" THEN
  2514.        GOSUB SkipOneWord
  2515.        CALL CallLib (-1824)'RESUMENEXT__
  2516.      ELSE
  2517.        GOSUB DumpLabel
  2518.        CALL CallLib (-1830)'RESUME_Z_
  2519.      END IF
  2520.    END IF
  2521.  
  2522. ' RETURN [Marke]
  2523.  ELSEIF Command$ = "RETURN" THEN
  2524.    IF FirstWord > LastWord THEN
  2525.      CALL CallLib (-1848)'RETURN__
  2526.    ELSE
  2527.      GOSUB DumpLabel
  2528.      CALL CallLib (-1842)'RETURN_Z_
  2529.    END IF
  2530.  
  2531. ' RSET Zeichenkettenvariable = x$
  2532.  ELSEIF Command$ = "RSET" THEN
  2533.    GOTO NotImplemented
  2534.  
  2535. ' RUN [Marke]
  2536.  ELSEIF Command$ = "RUN" THEN
  2537.    IF FirstWord > LastWord THEN
  2538.      CALL CallLib (-1878)'RUN__
  2539.    ELSE
  2540.      GOSUB DumpLabel
  2541.      CALL CallLib (-1872)'RUN_Z_
  2542.    END IF
  2543.  
  2544. ' SAVE [Dateinangabe][,A][,P][,B]
  2545.  ELSEIF Command$ = "SAVE" THEN
  2546.    GOTO NotCompilable
  2547.  
  2548. ' SAY Zeichenkette[,Modus]
  2549.  ELSEIF Command$ = "SAY" THEN
  2550.    GOTO NotImplemented
  2551.  
  2552. ' SCREEN n,Breite,Höhe,Tiefe,Modus / SCREEN CLOSE n
  2553.  ELSEIF Command$ = "SCREEN" THEN
  2554.    IF FirstWord <= LastWord AND Word$(FirstWord) = "CLOSE" THEN
  2555.      GOSUB SkipOneWord
  2556.      ExprFlags = VarINT : GOSUB DumpExpr
  2557.      CALL CallLib (-1890)'SCREENCLOSE_I_
  2558.    ELSE
  2559.      ExprFlags = VarINT : GOSUB DumpExpr
  2560.      GOSUB SkipKomma
  2561.      ExprFlags = VarINT : GOSUB DumpExpr
  2562.      GOSUB SkipKomma
  2563.      ExprFlags = VarINT : GOSUB DumpExpr
  2564.      GOSUB SkipKomma
  2565.      ExprFlags = VarINT : GOSUB DumpExpr
  2566.      GOSUB SkipKomma
  2567.      ExprFlags = VarINT : GOSUB DumpExpr
  2568.      CALL CallLib (-1896)'SCREEN_IIIII_
  2569.    END IF
  2570.  
  2571. ' SCROLL (x1,y1)-(x2,y2),deltax,deltay
  2572.  ELSEIF Command$ = "SCROLL" THEN
  2573.    GOSUB DumpGfxPoint
  2574.    IF FirstWord > LastWord OR Word$(FirstWord) <> "-" THEN SyntaxError
  2575.    GOSUB SkipOneWord
  2576.    GOSUB DumpGfxPoint
  2577.    GOSUB SkipKomma
  2578.    ExprFlags = VarINT : GOSUB DumpExpr
  2579.    GOSUB SkipKomma
  2580.    ExprFlags = VarINT : GOSUB DumpExpr
  2581.    CALL CallLib (-1902)'SCROLL_IIIIII_
  2582.  
  2583. ' SHARED Varibale[()][,Varibale[()]]...
  2584.  ELSEIF Command$ = "SHARED" THEN
  2585.    IF SubNumber = 1 THEN CALL SomeError ("SHARED not allowed in the main program",CommandPos) : EXIT SUB
  2586.    ExpectKomma = FALSE
  2587.    WHILE FirstWord <= LastWord OR ExpectKomma = FALSE
  2588.      IF ExpectKomma THEN
  2589.        GOSUB SkipKomma
  2590.      ELSE
  2591.        ExpectKomma = TRUE
  2592.      END IF
  2593.      IF FirstWord > LastWord THEN NeedSomethingError
  2594.      IF IsVar(FirstWord) = FALSE OR (WordVarFlags(FirstWord) AND VarCONST) <> 0 THEN CALL SomeError ("Expected a variable",WordPos(FirstWord)) : EXIT SUB
  2595.      IF FirstWord < LastWord AND Word$(FirstWord+1) = "(" THEN
  2596.        CALL GetVarNum (Word$(FirstWord),WordVarFlags(FirstWord),0,0)
  2597.        GOSUB SkipOneWord
  2598.        GOSUB SkipOneWord
  2599.        IF FirstWord > LastWord OR Word$(FirstWord) <> ")" THEN CALL SomeError ("Expected ')'",WordPos(FirstWord)) : EXIT SUB
  2600.        GOSUB SkipOneWord
  2601.      ELSE
  2602.        CALL GetVarNum (Word$(FirstWord),WordVarFlags(FirstWord),-1,0)
  2603.        GOSUB SkipOneWord
  2604.      END IF
  2605.    WEND
  2606.  
  2607. ' SLEEP
  2608.  ELSEIF Command$ = "SLEEP" THEN
  2609.    CALL CallLib (-2004)'SLEEP__
  2610.  
  2611. ' SOUND Frequenz,Dauer[,[Laut][,Kanal]]
  2612.  ELSEIF Command$ = "SOUND" THEN
  2613.    IF FirstWord <= LastWord AND Word$(FirstWord) = "WAIT" THEN
  2614.      CALL CallLib (-2016)'SOUNDWAIT__
  2615.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "RESUME" THEN
  2616.      CALL CallLib (-2010)'SOUNDRESUME__
  2617.    ELSE
  2618.      ExprFlags = VarINT : GOSUB DumpExpr
  2619.      GOSUB SkipKomma
  2620.      ExprFlags = VarINT : GOSUB DumpExpr
  2621.      IF FirstWord <= LastWord THEN GOSUB SkipKomma
  2622.      IF FirstWord <= LastWord THEN
  2623.        ExprFlags = VarINT : GOSUB DumpExpr
  2624.      ELSE
  2625.        CALL SubDumpVar ("127",VarINT+VarCONST,-1)
  2626.      END IF
  2627.      IF FirstWord <= LastWord THEN GOSUB SkipKomma
  2628.      IF FirstWord <= LastWord THEN
  2629.        ExprFlags = VarINT : GOSUB DumpExpr
  2630.      ELSE
  2631.        CALL SubDumpVar ("0",VarINT+VarCONST,-1)
  2632.      END IF
  2633.      CALL CallLib (-2022)'SOUND_IIII_
  2634.    END IF
  2635.  
  2636. ' STOP
  2637.  ELSEIF Command$ = "STOP" THEN
  2638.    GOTO NotCompilable
  2639.  
  2640. ' SUB Name [(Liste form. Param.)] STATIC
  2641.  ELSEIF Command$ = "SUB" THEN
  2642.    IF SubNumber <> 1 THEN CALL SomeError ("SUB within another SUB",CommandPos) : EXIT SUB
  2643.    CALL TestStack (CommandPos)
  2644.    SubCounter = SubCounter+1
  2645.    SubNumber = SubCounter
  2646.    CALL CreateLabel
  2647.    SkipSubLabel$ = Ergebnis$
  2648.    CALL CreateLabel
  2649.    LeaveSubLabel$ = Ergebnis$
  2650.    CALL SubDumpLabel (SkipSubLabel$)
  2651.    CALL CallLib (-840)'GOTO_Z_
  2652. ' Auf Zeilenmarkierung testen und Sub-Nummer holen
  2653.    IF FirstWord > LastWord THEN CALL SomeError ("Expected a label",WordPos(FirstWord)) : EXIT SUB
  2654.    CALL CouldThisBeALabel (FirstWord)
  2655.    IF Ergebnis = FALSE THEN CALL SomeError ("Expected a label",WordPos(FirstWord)) : EXIT SUB
  2656.    LabelPointer = FirstWord
  2657.    GOSUB SkipOneWord
  2658.    CALL GetMySubNum (Word$(LabelPointer),TRUE)
  2659.    IF Ergebnis = -1 THEN EXIT SUB
  2660.    MySubNumber = Ergebnis
  2661. ' STATIC suchen und vergessen
  2662.    FOR a = FirstWord TO LastWord
  2663.      IF Word$(a) = "STATIC" THEN FoundStatic
  2664.    NEXT a
  2665.    CALL SomeError ("STATIC missing in SUB-command",CommandPos) : EXIT SUB
  2666.  FoundStatic:
  2667.    IF a <> LastWord THEN CALL SomeError ("STATIC must be the end of the SUB-command",WordPos(a+1)) : EXIT SUB
  2668.    LastWord = LastWord-1
  2669. ' ggf. Klammern entfernen
  2670.    CALL TryRemBrackets (FirstWord,LastWord)
  2671.    FirstWord = FirstWord+Ergebnis
  2672.    LastWord = LastWord-Ergebnis
  2673. ' Fuer die Rueckgabe die Parameter auf dem Stack ablegen
  2674.    CALL SubSetLabel (LeaveSubLabel$)
  2675.    ExpectKomma = FALSE
  2676.    a = 0
  2677.    WHILE FirstWord <= LastWord
  2678.      IF ExpectKomma THEN
  2679.        GOSUB SkipKomma
  2680.      ELSE
  2681.        ExpectKomma = TRUE
  2682.      END IF
  2683.      ParPos(a) = FirstWord
  2684.      CALL GetVarEnd (FirstWord,LastWord,TRUE)
  2685.      IF Ergebnis = -1 THEN EXIT SUB
  2686.      EndOfVar = Ergebnis
  2687.      CALL GetExprEnd (FirstWord,LastWord)
  2688.      IF Ergebnis = -1 THEN EXIT SUB
  2689.      IF Ergebnis <> EndOfVar THEN CALL SomeError ("Expected a variable",WordPos(FirstWord)) : EXIT SUB
  2690.      ErrorPos = WordPos(FirstWord)
  2691.      ExprFlags = VarTEXT OR VarINT OR VarLONG OR VarREAL OR VarDOUB : GOSUB DumpExpr
  2692.      IF Pass = 1 THEN
  2693.        IF NumSubPars(MySubNumber) = MaxSubPars THEN CALL SomeError ("SUB: Too many parameters",ErrorPos) : EXIT SUB
  2694.        NumSubPars(MySubNumber) = NumSubPars(MySubNumber)+1
  2695.        SubParType(MySubNumber,NumSubPars(MySubNumber)) = Ergebnis
  2696.      END IF
  2697.      a = a+1
  2698.    WEND
  2699.    CALL CallLib (-510)'ENDSUB__
  2700.    CALL SubSetLabel ("_"+Word$(LabelPointer))
  2701.    IF Pass > 1 THEN
  2702.      CALL SubIntToString (SubSize(SubNumber,0))
  2703.      CALL SubDumpVar (Ergebnis$,VarINT+VarCONST,-1)
  2704.      CALL SubIntToString (SubSize(SubNumber,1))
  2705.      CALL SubDumpVar (Ergebnis$,VarINT+VarCONST,-1)
  2706.      CALL CallLib (-2106)'SUB_II_
  2707.    END IF
  2708.    FOR a = NumSubPars(MySubNumber) TO 0 STEP -1
  2709.      FirstWord = ParPos(a)
  2710.      CALL GetVarEnd (FirstWord,LastWord,FALSE)
  2711.      CALL SubDumpSetVar (FirstWord,Ergebnis,SubParType(MySubNumber,a))
  2712.      IF Ergebnis = FALSE THEN EXIT SUB
  2713.    NEXT a
  2714.    FirstWord = LastWord+1
  2715.  
  2716. ' SWAP Var1,Var2
  2717.  ELSEIF Command$ = "SWAP" THEN
  2718.    StartPos = WordPos(FirstWord)
  2719.    VarFlags = VarTEXT OR VarINT OR VarLONG OR VarREAL OR VarDOUB : GOSUB DumpVarPointer : Pointer1 = Ergebnis
  2720.    GOSUB SkipKomma
  2721.    VarFlags = VarTEXT OR VarINT OR VarLONG OR VarREAL OR VarDOUB : GOSUB DumpVarPointer : Pointer2 = Ergebnis
  2722.    IF Pointer1 <> Pointer2 THEN
  2723.      CALL SomeError ("SWAP: variables must have exactly the same type",StartPos) : EXIT SUB
  2724.    ELSE
  2725.      IF Pointer1 = VarTEXT THEN
  2726.        CALL CallLib (-2154)'SWAP_tt_
  2727.      ELSEIF Pointer1 = VarINT THEN
  2728.        CALL CallLib (-2136)'SWAP_ii_
  2729.      ELSEIF Pointer1 = VarLONG THEN
  2730.        CALL CallLib (-2142)'SWAP_ll_
  2731.      ELSEIF Pointer1 = VarREAL THEN
  2732.        CALL CallLib (-2148)'SWAP_rr_
  2733.      ELSEIF Pointer1 = VarDOUB THEN
  2734.        CALL CallLib (-2130)'SWAP_dd_
  2735.      END IF
  2736.    END IF
  2737.  
  2738. ' SYSTEM
  2739.  ELSEIF Command$ = "SYSTEM" THEN
  2740.    CALL CallLib (-2160)'SYSTEM__
  2741.  
  2742. ' TIMER ON / TIMER OFF / TIMER STOP
  2743.  ELSEIF Command$ = "TIMER" THEN
  2744.    IF FirstWord <= LastWord AND Word$(FirstWord) = "ON" THEN
  2745.      GOSUB SkipOneWord
  2746.      CALL CallLib (-2184)'TIMERON__
  2747.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "OFF" THEN
  2748.      GOSUB SkipOneWord
  2749.      CALL CallLib (-2178)'TIMEROFF__
  2750.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "STOP" THEN
  2751.      GOSUB SkipOneWord
  2752.      CALL CallLib (-2190)'TIMERSTOP__
  2753.    ELSE
  2754.      GOTO SyntaxError
  2755.    END IF
  2756.  
  2757. ' TRON
  2758.  ELSEIF Command$ = "TRON" THEN
  2759.    IF IsDebugUsed THEN
  2760.      CALL CallLib (-2220)'TRON__
  2761.    END IF
  2762.  
  2763. ' TROFF
  2764.  ELSEIF Command$ = "TROFF" THEN
  2765.    IF IsDebugUsed THEN
  2766.      CALL CallLib (-2214)'TROFF__
  2767.    END IF
  2768.  
  2769. ' WAVE Kanal,Definition
  2770.  ELSEIF Command$ = "WAVE" THEN
  2771.    GOTO NotImplemented
  2772.  
  2773. ' WHILE Ausdruck
  2774.  ELSEIF Command$ = "WHILE" THEN
  2775.    StackType = TypeWHILE : GOSUB Push
  2776.    CALL CreateLabel : Stack$(StackPointer,0) = Ergebnis$
  2777.    CALL CreateLabel : Stack$(StackPointer,1) = Ergebnis$
  2778.    CALL SubSetLabel (Stack$(StackPointer,0))
  2779.    IF Ergebnis = FALSE THEN EXIT SUB
  2780.    ExprFlags = VarINT : GOSUB DumpExpr
  2781.    CALL SubDumpLabel (Stack$(StackPointer,1))
  2782.    CALL CallLib (-912)'IF_IZ_
  2783.  
  2784. ' WEND
  2785.  ELSEIF Command$ = "WEND" THEN
  2786.    StackType = TypeWHILE : GOSUB Pull
  2787.    CALL SubDumpLabel (Stack$(StackPointer+1,0))
  2788.    CALL CallLib (-840)'GOTO_Z_
  2789.    CALL SubSetLabel (Stack$(StackPointer+1,1))
  2790.    IF Ergebnis = FALSE THEN EXIT SUB
  2791.  
  2792. ' WIDTH [LPRINT] [Breite][,Druckzone] / WIDTH #Dateinr [,Breite][,Druckzone] / WIDTH Gerät[,Breite][,Druckzone]
  2793.  ELSEIF Command$ = "WIDTH" THEN
  2794.    GOTO NotImplemented
  2795.  
  2796. ' WINDOW Kennung [,[Titel][,[(x1,y1)-(x2,y2)][,[Typ][,Schirm]]]] / WINDOW OUTPUT Kennung / WINDOW CLOSE Kennung
  2797.  ELSEIF Command$ = "WINDOW" THEN
  2798.    IF FirstWord <= LastWord AND Word$(FirstWord) = "OUTPUT" THEN
  2799.      GOSUB SkipOneWord
  2800.      ExprFlags = VarINT : GOSUB DumpExpr
  2801.      CALL CallLib (-2244)'WINDOWOUTPUT_I_
  2802.    ELSEIF FirstWord <= LastWord AND Word$(FirstWord) = "CLOSE" THEN
  2803.      GOSUB SkipOneWord
  2804.      ExprFlags = VarINT : GOSUB DumpExpr
  2805.      CALL CallLib (-2238)'WINDOWCLOSE_I_
  2806.    ELSE
  2807.      ExprFlags = VarINT : GOSUB DumpExpr
  2808.      IF FirstWord <= LastWord THEN GOSUB SkipKomma
  2809.      IF FirstWord <= LastWord AND Word$(FirstWord) <> "," THEN
  2810.        ExprFlags = VarTEXT : GOSUB DumpExpr
  2811.      ELSE
  2812.        CALL SubDumpVar ("Cursor V1.0 (c) 1990 Jürgen Forster",VarTEXT+VarCONST,-1)
  2813.      END IF
  2814.      IF FirstWord <= LastWord THEN GOSUB SkipKomma
  2815.      IF FirstWord <= LastWord AND Word$(FirstWord) <> "," THEN
  2816.        GOSUB DumpGfxPoint
  2817.        IF FirstWord > LastWord OR Word$(FirstWord) <> "-" THEN SyntaxError
  2818.        GOSUB SkipOneWord
  2819.        GOSUB DumpGfxPoint
  2820.      ELSE
  2821.        CALL CallLib (-792)'GETWINDOWSIZE__II
  2822.      END IF
  2823.      IF FirstWord <= LastWord THEN GOSUB SkipKomma
  2824.      IF FirstWord <= LastWord AND Word$(FirstWord) <> "," THEN
  2825.        ExprFlags = VarINT : GOSUB DumpExpr
  2826.      ELSE
  2827.        CALL SubDumpVar ("15",VarINT+VarCONST,-1)
  2828.      END IF
  2829.      IF FirstWord <= LastWord THEN GOSUB SkipKomma
  2830.      IF FirstWord <= LastWord THEN
  2831.        ExprFlags = VarINT : GOSUB DumpExpr
  2832.      ELSE
  2833.        CALL SubDumpVar ("1",VarINT+VarCONST,-1)
  2834.      END IF
  2835.      CALL CallLib (-2250)'WINDOW_ITIIIIII_
  2836.    END IF
  2837.  
  2838. ' WRITE [#Dateinr,][Liste von Ausdr]
  2839.  ELSEIF Command$ = "WRITE" THEN
  2840.    GOTO NotImplemented
  2841.  
  2842.  ELSE
  2843.    NotFound = NotFound+1
  2844.  END IF
  2845.  
  2846.  IF NotFound = 2 THEN
  2847.    CALL SomeError ("Keyword not expected here",CommandPos) : EXIT SUB
  2848.  END IF
  2849.  
  2850.  GOSUB CheckRest
  2851.  EXIT SUB
  2852.  
  2853. '************************************************************
  2854. '*                                                          *
  2855. '* Routinen, die von ähnlichen Befehlen genutzt werden      *
  2856. '*                                                          *
  2857. '************************************************************
  2858.  
  2859. '
  2860. ' Fuer die DEFTyp-Anweisung
  2861. '
  2862.  
  2863. HandleDefType:
  2864.  ExpectKomma = FALSE
  2865.  WHILE FirstWord <= LastWord
  2866.    IF ExpectKomma THEN
  2867.      GOSUB SkipKomma
  2868.    ELSE
  2869.      ExpectKomma = TRUE
  2870.    END IF
  2871.    ErrorPos = WordPos(FirstWord)
  2872.    GOSUB GetCharNumber : Char1 = Ergebnis
  2873.    IF FirstWord <= LastWord AND Word$(FirstWord) = "-" THEN
  2874.      GOSUB SkipOneWord
  2875.      GOSUB GetCharNumber : Char2 = Ergebnis
  2876.    ELSE
  2877.      Char2 = Char1
  2878.    END IF
  2879.    IF Char1 > Char2 THEN
  2880.      CALL SomeError ("Source greater than target",ErrorPos) : EXIT SUB
  2881.    ELSE
  2882.      FOR a = Char1 TO Char2
  2883.        CharVarType(a) = DefType
  2884.      NEXT a
  2885.    END IF
  2886.  WEND
  2887.  RETURN
  2888.  
  2889. GetCharNumber:
  2890.  IF FirstWord > LastWord THEN CALL SomeError ("Expected a letter",WordPos(FirstWord)) : EXIT SUB
  2891.  IF LEN(Word$(FirstWord)) <> 1 THEN SyntaxError
  2892.  IF ASC(Word$(FirstWord)) > ASC("Z") OR ASC(Word$(FirstWord)) < ASC("A") THEN SyntaxError
  2893.  Ergebnis = ASC(Word$(FirstWord))-ASC("A")
  2894.  GOSUB SkipOneWord
  2895.  RETURN
  2896.  
  2897. '
  2898. ' Fuer die INPUT-Anweisung
  2899. '
  2900.  
  2901. HandleInputLine:
  2902.  CALL CallLib (-942)'INPUT__
  2903.  ExpectKomma = FALSE
  2904.  WHILE FirstWord <= LastWord OR ExpectKomma = FALSE
  2905.    IF ExpectKomma THEN
  2906.      GOSUB SkipKomma
  2907.    ELSE
  2908.      ExpectKomma = TRUE
  2909.    END IF
  2910.    CALL CallLib (-738)'GETINPUTPART__T
  2911.    StackFlags = VarTEXT : GOSUB DumpSetVar
  2912.  WEND
  2913.  CALL CallLib (-180)'CHECKINPUTEND__
  2914.  RETURN
  2915.  
  2916. '************************************************************
  2917. '*                                                          *
  2918. '* Routinen zum Auswerten der Befehle                       *
  2919. '*                                                          *
  2920. '************************************************************
  2921.  
  2922. '
  2923. ' Ein Wort ueberlesen
  2924. '
  2925.  
  2926. SkipOneWord:
  2927.  IF FirstWord > LastWord THEN CALL SomeError ("Expected something",WordPos(FirstWord)) : EXIT SUB
  2928.  FirstWord = FirstWord+1
  2929.  RETURN
  2930.  
  2931. '
  2932. ' Pruefen noch etwas vorhanden ist, wenn nicht Fehlermeldung ausgeben
  2933. '
  2934.  
  2935. CheckRest:
  2936.  IF FirstWord <= LastWord THEN CALL SomeError ("Expected end of command",WordPos(FirstWord)) : EXIT SUB
  2937.  RETURN
  2938.  
  2939. '
  2940. ' Einen Ausdruck auswerten. Die angeforderten Eigenschaften werden
  2941. ' in ExprFlags bergeben, das tatsächliche Ergebnis steht dann in Ergebnis
  2942. '
  2943.  
  2944. DumpExpr:
  2945.  CALL GetExprEnd (FirstWord,LastWord)
  2946.  IF Ergebnis = -1 THEN EXIT SUB
  2947.  EndOfExpr = Ergebnis
  2948.  CALL SubDumpExpr (FirstWord,EndOfExpr,ExprFlags)
  2949.  IF Ergebnis = FALSE THEN EXIT SUB
  2950.  FirstWord = EndOfExpr+1
  2951.  RETURN
  2952.  
  2953. '
  2954. ' Den Wert vom Stack in eine Variable schreiben
  2955. '
  2956.  
  2957. DumpSetVar:
  2958.  CALL GetVarEnd (FirstWord,LastWord,TRUE)
  2959.  IF Ergebnis = -1 THEN EXIT SUB
  2960.  EndOfVar = Ergebnis
  2961.  CALL SubDumpSetVar (FirstWord,EndOfVar,StackFlags)
  2962.  IF Ergebnis = FALSE THEN EXIT SUB
  2963.  FirstWord = EndOfVar+1
  2964.  RETURN
  2965.  
  2966. '
  2967. ' Eine Zeilenmarkierung ablegen
  2968. '
  2969.  
  2970. DumpLabel:
  2971.  IF FirstWord > LastWord THEN CALL SomeError ("Expected a label",WordPos(FirstWord)) : EXIT SUB
  2972.  CALL CouldThisBeALabel (FirstWord)
  2973.  IF Ergebnis = FALSE THEN CALL SomeError ("Expected a label",WordPos(FirstWord)) : EXIT SUB
  2974.  CALL SubDumpLabel (Word$(FirstWord))
  2975.  GOSUB SkipOneWord
  2976.  RETURN
  2977.  
  2978. '
  2979. ' Koordinaten eines Bildschirmpunktes ausgeben
  2980. '
  2981.  
  2982. DumpGfxPoint:
  2983.  GOSUB TestGfxEnd
  2984.  FoundStep = Word$(FirstWord) = "STEP"
  2985.  IF FoundStep THEN FirstWord = FirstWord+1 : GOSUB TestGfxEnd
  2986.  IF Word$(FirstWord) <> "(" THEN CALL SomeError ("Expected '('",WordPos(FirstWord)) : EXIT SUB
  2987.  GOSUB SkipOneWord
  2988.  ExprFlags = VarINT : GOSUB DumpExpr
  2989.  GOSUB SkipKomma
  2990.  ExprFlags = VarINT : GOSUB DumpExpr
  2991.  GOSUB TestGfxEnd
  2992.  IF Word$(FirstWord) <> ")" THEN CALL SomeError ("Expected ')'",WordPos(FirstWord)) : EXIT SUB
  2993.  GOSUB SkipOneWord
  2994.  IF FoundStep THEN CALL CallLib (-828)'GFXSTEP_II_II
  2995.  RETURN
  2996.  
  2997. TestGfxEnd:
  2998.  IF FirstWord > LastWord THEN CALL SomeError ("Expecting point-coordinates",WordPos(FirstWord)) : EXIT SUB
  2999.  RETURN
  3000.  
  3001. '
  3002. ' Prueft auf ein Komma und ueberliest es
  3003. '
  3004.  
  3005. SkipKomma:
  3006.  IF FirstWord > LastWord OR Word$(FirstWord) <> "," THEN CALL SomeError ("Expected comma",WordPos(FirstWord)) : EXIT SUB
  3007.  GOSUB SkipOneWord
  3008.  RETURN
  3009.  
  3010. '
  3011. ' Ausgabe von Fehlermeldungen
  3012. '
  3013.  
  3014. NeedSomethingError:
  3015.  CALL SomeError (Command$+": Expected something",WordPos(FirstWord)) : EXIT SUB
  3016.  
  3017. SyntaxError:
  3018.  CALL SomeError (Command$+": Syntax error",WordPos(FirstWord)) : EXIT SUB
  3019.  
  3020. NotCompilable:
  3021.  CALL SomeError (Command$+"-command cannot be compiled",CommandPos) : EXIT SUB
  3022.  
  3023. NotImplemented:
  3024.  CALL SomeError (Command$+"-command is not yet implemented",CommandPos) : EXIT SUB
  3025.  
  3026. '
  3027. ' Prueft, ob zu einer END IF / WEND / NEXT - Anweisung eine IF / WHILE / FOR-
  3028. ' Anweisung existiert
  3029. '
  3030.  
  3031. Push:
  3032.  IF StackPointer = MaxStack THEN CALL SomeError ("Too many IF/WHILE/FOR-commands",-1) : CALL EndPrg
  3033.  StackPointer = StackPointer+1
  3034.  StackType(StackPointer) = StackType
  3035.  StackLine(StackPointer) = ThisLine
  3036.  RETURN
  3037.  
  3038. Pull:
  3039.  StackError = FALSE
  3040.  IF StackPointer < 0 THEN
  3041.    StackError = TRUE
  3042.  ELSE
  3043.    IF StackType(StackPointer) <> StackType THEN
  3044.      StackError = TRUE
  3045.    END IF
  3046.  END IF
  3047.  IF StackError THEN
  3048.    IF StackType = TypeWHILE THEN
  3049.      CALL SomeError ("WEND without WHILE",-1)
  3050.    ELSEIF StackType = TypeIF THEN
  3051.      CALL SomeError ("END IF without IF",-1)
  3052.    ELSEIF StackType = TypeFOR THEN
  3053.      CALL SomeError ("NEXT without FOR",-1)
  3054.    END IF
  3055.    IF StackPointer >= 0 THEN
  3056.      IF StackType(StackPointer) = TypeWHILE THEN
  3057.        PRINT "see: WHILE-command in line";StackLine(StackPointer)
  3058.      ELSEIF StackType(StackPointer) = TypeIF THEN
  3059.        PRINT "see: IF-command in line";StackLine(StackPointer)
  3060.      ELSEIF StackType(StackPointer) = TypeFOR THEN
  3061.        PRINT "see: FOR-command in line";StackLine(StackPointer)
  3062.      END IF
  3063.    END IF
  3064.    EXIT SUB
  3065.  END IF
  3066.  StackPointer = StackPointer-1
  3067.  RETURN
  3068.  
  3069. '
  3070. ' Prueft, ob zu einer END IF / WEND / NEXT - Anweisung eine IF / WHILE / FOR-
  3071. ' Anweisung existiert
  3072. '
  3073.  
  3074. SkipOneVar:
  3075.  CALL GetVarEnd (FirstWord,LastWord,TRUE)
  3076.  IF Ergebnis = -1 THEN EXIT SUB
  3077.  FirstWord = Ergebnis+1
  3078.  RETURN
  3079.  
  3080. '
  3081. ' Legt den Zeiger auf eine Variable auf dem Stack ab
  3082. '
  3083.  
  3084. DumpVarPointer:
  3085.  CALL GetVarEnd (FirstWord,LastWord,TRUE)
  3086.  IF Ergebnis = -1 THEN EXIT SUB
  3087.  VarEndPointer = Ergebnis
  3088.  CALL SubDumpVarPointer (FirstWord,VarEndPointer)
  3089.  IF Ergebnis = FALSE THEN EXIT SUB
  3090.  IF (Ergebnis AND VarFlags) = 0 THEN CALL SomeError ("Expected a variable with another type",WordPos(FirstWord)) : EXIT SUB
  3091.  FirstWord = VarEndPointer+1
  3092.  RETURN
  3093.  
  3094. '
  3095. ' Legt nur den Zeiger auf ein Feld ab
  3096. '
  3097.  
  3098. DumpFieldPointer:
  3099.  IF FirstWord > LastWord THEN CALL SomeError ("Expected name of a field",WordPos(FirstWord)) : EXIT SUB
  3100.  CALL SubDumpSimpleVarPointer (Word$(FirstWord),WordVarFlags(FirstWord),0)
  3101.  GOTO SkipOneWord
  3102.  
  3103. END SUB
  3104.  
  3105. '************************************************************
  3106. '*                                                          *
  3107. '* Ist der Parameter eine Zeilenmarkierung?                 *
  3108. '*                                                          *
  3109. '************************************************************
  3110.  
  3111. SUB CouldThisBeALabel (WordNumber) STATIC
  3112.  IF IsVar(WordNumber) THEN
  3113.    IF (WordVarFlags(WordNumber) AND VarCONST) = FALSE THEN
  3114.      CALL IsKeyWord (Word$(WordNumber))
  3115.      IF Ergebnis = FALSE THEN
  3116.        Ergebnis = TRUE : EXIT SUB
  3117.      END IF
  3118.    ELSE
  3119.      FOR a = 1 TO LEN(Word$(WordNumber))
  3120.        IF INSTR(CharNumber$,MID$(Word$(WordNumber),a,1)) = 0 THEN Ergebnis = FALSE : EXIT SUB
  3121.      NEXT a
  3122.      Ergebnis = TRUE : EXIT SUB
  3123.    END IF
  3124.  END IF
  3125.  Ergebnis = FALSE
  3126. END SUB
  3127.  
  3128. '************************************************************
  3129. '*                                                          *
  3130. '* Fehlermeldung ausgeben                                   *
  3131. '*                                                          *
  3132. '************************************************************
  3133.  
  3134. SUB SomeError (Fehler$,Position) STATIC
  3135.  PRINT
  3136.  PRINT FileName$;".bas, line";ThisLine;":"
  3137.  PRINT SourceLine$
  3138.  IF Position > 0 THEN
  3139.    PRINT SPACE$(Position-1);"^"
  3140.  ELSE
  3141.    PRINT
  3142.  END IF
  3143.  PRINT Fehler$
  3144.  NumErrors = NumErrors+1
  3145.  ErrorInThisLine = TRUE
  3146.  IF Pass = 3 THEN
  3147.    PRINT : PRINT "Error in pass 3 - Aborting"
  3148.    CLOSE
  3149.    KILL FileName$
  3150.    KILL "T:Reloc32"
  3151.    CALL EndPrg
  3152.  END IF
  3153. END SUB
  3154.  
  3155. '************************************************************
  3156. '*                                                          *
  3157. '* Ist das Wort ein Schluesselwort?                         *
  3158. '*                                                          *
  3159. '************************************************************
  3160.  
  3161. SUB IsKeyWord (Word$) STATIC
  3162.  Von = 0 : Bis = NumKeyWords
  3163.  WHILE Von <= Bis
  3164.    Mitte = INT((Von+Bis)\2)
  3165.    IF KeyWord$(Mitte) > Word$ THEN
  3166.      Bis = Mitte-1
  3167.    ELSE
  3168.      IF KeyWord$(Mitte) = Word$ THEN Ergebnis = TRUE : EXIT SUB
  3169.      Von = Mitte+1
  3170.    END IF
  3171.  WEND
  3172.  Ergebnis = FALSE
  3173. END SUB
  3174.  
  3175. '************************************************************
  3176. '*                                                          *
  3177. '* Funktionsnummer suchen                                   *
  3178. '*                                                          *
  3179. '************************************************************
  3180.  
  3181. SUB GetOperatorNum (Func$) STATIC
  3182.  Von = 0 : Bis = NumFuncs
  3183.  WHILE Von <= Bis
  3184.    Mitte = INT((Von+Bis)\2)
  3185.    IF Func$(Mitte) > Func$ THEN
  3186.      Bis = Mitte-1
  3187.    ELSE
  3188.      IF Func$(Mitte) = Func$ THEN Ergebnis = Mitte : EXIT SUB
  3189.      Von = Mitte+1
  3190.    END IF
  3191.  WEND
  3192.  Ergebnis = -1
  3193. END SUB
  3194.  
  3195. '************************************************************
  3196. '*                                                          *
  3197. '* Welchen Typ hat der Uebergebene String?                  *
  3198. '*                                                          *
  3199. '************************************************************
  3200.  
  3201. SUB GetVarFlags (Var$) STATIC
  3202.  a$ = Var$
  3203.  Ergebnis = 0
  3204.  IF INSTR(CharLetter$,LEFT$(a$,1)) THEN
  3205.    IF INSTR(CharTypes$,RIGHT$(a$,1)) = 0 THEN
  3206.      Ergebnis = CharVarType(ASC(a$)-ASC("A"))
  3207.    END IF
  3208.  ELSE
  3209.    IF INSTR(CharTypes$,RIGHT$(a$,1)) = 0 THEN
  3210.      IF INSTR(a$,".") THEN
  3211.        Ergebnis = VarREAL
  3212.      ELSE
  3213.        Ergebnis = VarINT
  3214.      END IF
  3215.    END IF
  3216.    Ergebnis = Ergebnis OR VarCONST
  3217.  END IF
  3218.  
  3219.  IF RIGHT$(a$,1) = "$" THEN
  3220.    Ergebnis = Ergebnis OR VarTEXT
  3221.  ELSEIF RIGHT$(a$,1) = "%" THEN
  3222.    Ergebnis = Ergebnis OR VarINT
  3223.  ELSEIF RIGHT$(a$,1) = "&" THEN
  3224.    Ergebnis = Ergebnis OR VarLONG
  3225.  ELSEIF RIGHT$(a$,1) = "!" THEN
  3226.    Ergebnis = Ergebnis OR VarREAL
  3227.  ELSEIF RIGHT$(a$,1) = "#" THEN
  3228.    Ergebnis = Ergebnis OR VarDOUB
  3229.  END IF
  3230. END SUB
  3231.  
  3232. '************************************************************
  3233. '*                                                          *
  3234. '* Zeilenmarkierung erzeugen                                *
  3235. '*                                                          *
  3236. '************************************************************
  3237.  
  3238. SUB CreateLabel STATIC
  3239.  LabelCounter = LabelCounter+1
  3240.  Ergebnis$ = STR$(LabelCounter)
  3241.  Ergebnis$ = "L_"+RIGHT$(Ergebnis$,LEN(Ergebnis$)-1)
  3242. END SUB
  3243.  
  3244. '************************************************************
  3245. '*                                                          *
  3246. '* Gibt die Länge eines Ausdrucks zurueck                   *
  3247. '*                                                          *
  3248. '************************************************************
  3249.  
  3250. SUB GetExprEnd (Word1,Word2) STATIC
  3251.  FirstWord = Word1 : LastWord = Word2
  3252.  
  3253.  WHILE TRUE
  3254. SearchAgain:
  3255.    SearchingForExpr = TRUE
  3256.    IF FirstWord > LastWord THEN StopSearching
  3257.    IF Word$(FirstWord) = ";" THEN StopSearching
  3258.    IF Word$(FirstWord) = "," THEN StopSearching
  3259.    IF Word$(FirstWord) = ")" THEN StopSearching
  3260.    IF Word$(FirstWord) = "-" THEN FirstWord = FirstWord+1 : GOTO SearchAgain
  3261.    IF Word$(FirstWord) = "+" THEN FirstWord = FirstWord+1 : GOTO SearchAgain
  3262.    IF Word$(FirstWord) = "(" THEN
  3263.      FirstWord = FirstWord+1
  3264.      GOSUB SkipAfterBracket2
  3265.    ELSE
  3266. ' haben wir einen Operator?
  3267.      IF OperatorNum(FirstWord) = -1 THEN
  3268. ' jetzt mueßte eigentlich eine Variable vorhanden sein
  3269.        IF IsVar(FirstWord) = FALSE THEN CALL SomeError ("Word/Char not expected in an expression",WordPos(FirstWord)) : Ergebnis = -1 : EXIT SUB
  3270.        FirstWord = FirstWord+1
  3271.        IF FirstWord <= LastWord AND Word$(FirstWord) = "(" THEN
  3272.          FirstWord = FirstWord+1
  3273.          GOSUB SkipAfterBracket2
  3274.        END IF
  3275.      ELSE
  3276.        IF FuncType(OperatorNum(FirstWord)) = 1 THEN FirstWord = FirstWord+1 : GOTO SearchAgain
  3277.        IF FuncType(OperatorNum(FirstWord)) = 2 THEN CALL SomeError ("Dyadic operator needs two parameters",WordPos(FirstWord)) : Ergebnis = -1 : EXIT SUB
  3278.        IF FuncType(OperatorNum(FirstWord)) = 3 THEN
  3279.          FirstWord = FirstWord+1
  3280.          IF FirstWord <= LastWord AND Word$(FirstWord) = "(" THEN
  3281.            FirstWord = FirstWord+1
  3282.            GOSUB SkipAfterBracket2
  3283.          END IF
  3284.        END IF
  3285.      END IF
  3286.    END IF
  3287. ' geht der Audruck noch weiter (nur bei einem dyadischen Operator)?
  3288.    SearchingForExpr = FALSE
  3289.    IF FirstWord > LastWord THEN StopSearching
  3290.    IF OperatorNum(FirstWord) = -1 THEN StopSearching
  3291.    IF FuncType(OperatorNum(FirstWord)) <> 2 THEN StopSearching
  3292.    FirstWord = FirstWord+1
  3293.  WEND
  3294.  
  3295. SkipAfterBracket2:
  3296.  BLevel = 2
  3297.  WHILE BLevel <> 1
  3298.    IF FirstWord > LastWord THEN CALL SomeError ("Did not find end of brackets",WordPos(FirstWord)) : Ergebnis = -1 : EXIT SUB
  3299.    IF Word$(FirstWord) = "(" THEN BLevel = BLevel+1
  3300.    IF Word$(FirstWord) = ")" THEN BLevel = BLevel-1
  3301.    FirstWord = FirstWord+1
  3302.  WEND
  3303.  RETURN
  3304.  
  3305. StopSearching:
  3306.  IF SearchingForExpr THEN
  3307.    CALL SomeError ("Expected expression",WordPos(FirstWord)) : Ergebnis = -1
  3308.  ELSE
  3309.    Ergebnis = FirstWord-1
  3310.  END IF
  3311. END SUB
  3312.  
  3313. '************************************************************
  3314. '*                                                          *
  3315. '* Prueft den Stack und gibt ggf. Fehlermeldungen aus       *
  3316. '*                                                          *
  3317. '************************************************************
  3318.  
  3319. SUB TestStack (FromWhere) STATIC
  3320.  IF StackPointer <> -1 THEN
  3321.    WHILE StackPointer <> -1
  3322.      IF StackType(StackPointer) = TypeWHILE THEN
  3323.        CALL SomeError ("WHILE-command in line"+STR$(StackLine(StackPointer))+" without WEND",FromWhere)
  3324.      ELSEIF StackType(StackPointer) = TypeIF THEN
  3325.        CALL SomeError ("IF-command in line"+STR$(StackLine(StackPointer))+" without END IF",FromWhere)
  3326.      ELSEIF StackType(StackPointer) = TypeFOR THEN
  3327.        CALL SomeError ("FOR-command in line"+STR$(StackLine(StackPointer))+" without NEXT",FromWhere)
  3328.      END IF
  3329.      StackPointer = StackPointer-1
  3330.    WEND
  3331.  END IF
  3332. END SUB
  3333.  
  3334. '************************************************************
  3335. '*                                                          *
  3336. '* String ausrechnen und Type (auf Stack) zurueckgeben      *
  3337. '*                                                          *
  3338. '************************************************************
  3339.  
  3340. SUB SubDumpExpr (Par1,Par2,Par3) STATIC
  3341.  FirstWord = Par1 : LastWord = Par2 : Flags = Par3
  3342.  
  3343.  Level = 0
  3344.  Von(Level) = FirstWord
  3345.  Bis(Level) = LastWord
  3346.  
  3347.  FOR a = Von(Level) TO Bis(Level)
  3348.    IF INSTR("+-",Word$(a)) THEN
  3349.      AddOrSub = TRUE
  3350.      IF a = 0 THEN
  3351.        AddOrSub = FALSE
  3352.      ELSE
  3353.        IF Word$(a-1) = "(" THEN
  3354.          AddOrSub = FALSE
  3355.        ELSEIF Word$(a-1) = "," THEN
  3356.          AddOrSub = FALSE
  3357.        ELSEIF OperatorNum(a-1) <> -1 THEN
  3358.          IF FuncType(OperatorNum(a-1)) <> 3 THEN
  3359.            AddOrSub = FALSE
  3360.          END IF
  3361.        ELSEIF IsVar(a-1) THEN
  3362.        ELSE
  3363.          CALL IsKeyWord (Word$(a-1))
  3364.          IF Ergebnis THEN AddOrSub = FALSE
  3365.        END IF
  3366.      END IF
  3367.      IF AddOrSub = FALSE THEN
  3368.        IF Word$(a) = "+" THEN
  3369.          Word$(a) = "++"
  3370.        ELSE
  3371.          Word$(a) = "--"
  3372.        END IF
  3373.        CALL GetOperatorNum (Word$(a))
  3374.        OperatorNum(a) = Ergebnis
  3375.      END IF
  3376.    END IF
  3377.  NEXT a
  3378.  
  3379. '
  3380. ' Erste Rekursionstufe: Ergebnistypen bestimmen und verarbeiten
  3381. '
  3382.  
  3383. NextLevel = 1
  3384.  GOSUB GetReturnType
  3385.  
  3386. Level = 0
  3387.  GOSUB DumpCalculation
  3388.  
  3389. ' letzte Konvertierung versuchen
  3390.  IF (ReturnType(0) AND Flags) = 0 THEN
  3391.    IF Flags <> VarTEXT AND Flags <> VarINT AND Flags <> VarLONG AND Flags <> VarREAL AND Flags <> VarDOUB THEN
  3392.      IF ReturnType(0) AND VarTEXT THEN
  3393.        CALL SomeError ("Cannot convert TEXT to numeric variable",WordPos(FirstWord)) : Ergebnis = FALSE : EXIT SUB
  3394.      ELSE
  3395.        NumericFlag = Flags AND (VarINT+VarLONG+VarREAL+VarDOUB)
  3396.        CALL TryConv (ReturnType(0),NumericFlag,WordPos(FirstWord))
  3397.        IF Ergebnis = FALSE THEN
  3398.          EXIT SUB
  3399.        ELSE
  3400.          Ergebnis = NumericFlag
  3401.        END IF
  3402.      END IF
  3403.    ELSE
  3404.      CALL TryConv (ReturnType(0),Flags,WordPos(FirstWord))
  3405.      IF Ergebnis = FALSE THEN
  3406.        EXIT SUB
  3407.      ELSE
  3408.        Ergebnis = Flags
  3409.      END IF
  3410.    END IF
  3411.  ELSE
  3412.    Ergebnis = ReturnType(0)
  3413.  END IF
  3414.  Ergebnis = Ergebnis AND VarTypeMask
  3415.  EXIT SUB
  3416.  
  3417. GetReturnType:
  3418. ' initialisieren
  3419. ' Von(Level)/Bis(Level) werden uebergeben
  3420.  NumPars(Level) = -1
  3421. ' Noch kein Operator wurde gefunden
  3422.  FoundOperator(Level) = -1
  3423. ' OldLevel ist ggf. schon gesetzt
  3424. ' ReadPointer wird nur kurzzeitig benutzt
  3425. ' VariateNum wird später gesetzt
  3426. ' ReturnType wird zum Schluß gesetzt
  3427.  
  3428. ' Erwarteter Parameter nicht gefunden?
  3429.  IF Von(Level) > Bis(Level) THEN
  3430.    CALL SomeError ("Expected parameter",WordPos(Von(Level))) : Ergebnis = FALSE : EXIT SUB
  3431.  END IF
  3432.  
  3433.  CALL TryRemBrackets (Von(Level),Bis(Level))
  3434.  Von(Level) = Von(Level)+Ergebnis
  3435.  Bis(Level) = Bis(Level)-Ergebnis
  3436.  IF Von(Level) > Bis(Level) THEN CALL SomeError ("Expected expression",WordPos(Von(Level))) : Ergebnis = FALSE : EXIT SUB
  3437.  
  3438. ' Operator mit höchster FuncHierachie suchen
  3439.  BLevel = 0
  3440.  FOR a = Von(Level) TO Bis(Level)
  3441.    IF Word$(a) = "(" THEN
  3442.      BLevel = BLevel+1
  3443.    ELSEIF Word$(a) = ")" THEN
  3444.      BLevel = BLevel-1
  3445.      IF BLevel < 0 THEN CALL SomeError ("')' without '('",WordPos(a)) : Ergebnis = FALSE : EXIT SUB
  3446.    END IF
  3447.    IF BLevel = 0 AND OperatorNum(a) <> -1 THEN
  3448.      IF FoundOperator(Level) = -1 THEN
  3449.        FoundOperator(Level) = a
  3450.      ELSE
  3451.        IF FuncHierachie(OperatorNum(a)) => FuncHierachie(OperatorNum(FoundOperator(Level))) THEN
  3452.          FoundOperator(Level) = a
  3453.        END IF
  3454.      END IF
  3455.    END IF
  3456.  NEXT a
  3457.  IF BLevel <> 0 THEN CALL SomeError ("')' missing",WordPos(Bis(Level)+1)) : Ergebnis = FALSE : EXIT SUB
  3458.  IF FoundOperator(Level) = -1 THEN
  3459.    IF IsVar(Von(Level)) THEN
  3460.      IF Von(Level) < Bis(Level) THEN
  3461. ' Nur noch ein Feld wäre sinnvoll
  3462.        IF Word$(Von(Level)+1) <> "(" THEN CALL SomeError ("Syntax error",WordPos(Von(Level)+1)) : Ergebnis = FALSE : EXIT SUB
  3463.        IF Word$(Bis(Level)) <> ")" THEN CALL SomeError ("Expected ')'",WordPos(Bis(Level))) : Ergebnis = FALSE : EXIT SUB
  3464.        IF (WordVarFlags(Von(Level)) AND VarCONST) <> 0 THEN CALL SomeError ("Expected name of a field",WordPos(Von(Level))) : Ergebnis = FALSE : EXIT SUB
  3465.        ReturnType(Level) = WordVarFlags(Von(Level))
  3466.        ReadPointer(Level) = Von(Level)+2
  3467. ' Ist erste Dimension vorhanden
  3468.        IF Word$(ReadPointer(Level)) = "," THEN
  3469.          CALL SomeError ("Did not expect a comma here",WordPos(ReadPointer(Level))) : Ergebnis = FALSE : EXIT SUB
  3470.        END IF
  3471. ' Schleife ueber die Dimensionen
  3472.        WHILE ReadPointer(Level) <= Bis(Level)-1
  3473.          IF Word$(ReadPointer(Level)) = "," THEN ReadPointer(Level) = ReadPointer(Level)+1
  3474.          GOSUB GetNewLevel
  3475.          Von(NewLevel) = ReadPointer(Level)
  3476.          CALL GetExprEnd (ReadPointer(Level),Bis(Level)-1)
  3477.          IF Ergebnis = -1 THEN Ergebnis = FALSE : EXIT SUB
  3478.          Bis(NewLevel) = Ergebnis
  3479.          ReadPointer(Level) = Ergebnis+1
  3480.          GOSUB AddNewLevelReturnType
  3481.          IF ReadPointer(Level) <= Bis(Level)-1 AND Word$(ReadPointer(Level)) <> "," THEN
  3482.            CALL SomeError ("Expected comma",WordPos(ReadPointer(Level))) : Ergebnis = FALSE : EXIT SUB
  3483.          END IF
  3484.        WEND
  3485.        RETURN
  3486.      ELSE
  3487.        ReturnType(Level) = WordVarFlags(Von(Level)) : RETURN
  3488.      END IF
  3489.    END IF
  3490.  END IF
  3491.  
  3492.  IF FoundOperator(Level) = -1 THEN CALL SomeError ("Operator missing",WordPos(Von(Level))) : Ergebnis = FALSE : EXIT SUB
  3493.  
  3494. ' Monadischer Operator
  3495.  IF FuncType(OperatorNum(FoundOperator(Level))) = 1 THEN
  3496.    IF FoundOperator(Level) <> Von(Level) THEN CALL SomeError ("Parameter before monadic operator not allowed",WordPos(FoundOperator(Level))) : Ergebnis = FALSE : EXIT SUB
  3497.    GOSUB GetNewLevel
  3498.    Von(NewLevel) = FoundOperator(Level)+1
  3499.    Bis(NewLevel) = Bis(Level)
  3500.    GOSUB AddNewLevelReturnType
  3501.  END IF
  3502.  
  3503. ' Dyadischer Operator
  3504.  IF FuncType(OperatorNum(FoundOperator(Level))) = 2 THEN
  3505.    GOSUB GetNewLevel
  3506.    Von(NewLevel) = Von(Level)
  3507.    Bis(NewLevel) = FoundOperator(Level)-1
  3508.    GOSUB AddNewLevelReturnType
  3509.    GOSUB GetNewLevel
  3510.    Von(NewLevel) = FoundOperator(Level)+1
  3511.    Bis(NewLevel) = Bis(Level)
  3512.    GOSUB AddNewLevelReturnType
  3513.  END IF
  3514.  
  3515. ' Eine Funktion oder Systemvariable
  3516.  IF FuncType(OperatorNum(FoundOperator(Level))) = 3 THEN
  3517.    IF FoundOperator(Level) <> Von(Level) THEN CALL SomeError ("Parameter before function not allowed",FoundOperator(Level)) : Ergebnis = FALSE : EXIT SUB
  3518.  
  3519.    ReadPointer(Level) = FoundOperator(Level)+1
  3520.  
  3521. ' sind Parameter vorhanden?
  3522.    IF ReadPointer(Level) <= Bis(Level) THEN
  3523.  
  3524. ' Klammern entfernen
  3525.      IF Word$(ReadPointer(Level)) <> "(" THEN CALL SomeError ("Expected '('",WordPos(ReadPointer(Level))) : Ergebnis = FALSE : EXIT SUB
  3526.      ReadPointer(Level) = ReadPointer(Level)+1
  3527.      IF Word$(Bis(Level)) <> ")" THEN CALL SomeError ("Expected ')'",WordPos(Bis(Level))) : Ergebnis = FALSE : EXIT SUB
  3528.      Bis(Level) = Bis(Level)-1
  3529.  
  3530. ' sind noch immer Parameter vorhanden?
  3531.      IF ReadPointer(Level) <= Bis(Level) THEN
  3532.  
  3533. ' Testen, ob gleich ein Komma kommt
  3534.        IF Word$(ReadPointer(Level)) = "," THEN
  3535.          CALL SomeError ("Empty expression at the beginning of the "+Func$(Von(Level))+"-function",WordPos(ReadPointer(Level))) : Ergebnis = FALSE : EXIT SUB
  3536.        END IF
  3537.  
  3538.        WHILE ReadPointer(Level) <= Bis(Level)
  3539.          IF Word$(ReadPointer(Level)) = "," THEN ReadPointer(Level) = ReadPointer(Level)+1
  3540.          GOSUB GetNewLevel
  3541.          Von(NewLevel) = ReadPointer(Level)
  3542.          CALL GetExprEnd (ReadPointer(Level),Bis(Level))
  3543.          IF Ergebnis = -1 THEN Ergebnis = FALSE : EXIT SUB
  3544.          Bis(NewLevel) = Ergebnis
  3545.          ReadPointer(Level) = Ergebnis+1
  3546.          GOSUB AddNewLevelReturnType
  3547.          IF ReadPointer(Level) <= Bis(Level) AND Word$(ReadPointer(Level)) <> "," THEN
  3548.            CALL SomeError ("Expected comma",WordPos(ReadPointer(Level))) : Ergebnis = FALSE : EXIT SUB
  3549.          END IF
  3550.        WEND
  3551.  
  3552. ' waren Parameter vorhanden?
  3553.      END IF
  3554.    END IF
  3555.  
  3556.  END IF
  3557.  
  3558.  FOR a = 0 TO NumVarianten(OperatorNum(FoundOperator(Level)))
  3559.    IF NumPars(Level) = NumParameter(OperatorNum(FoundOperator(Level)),a) THEN
  3560.      FOR b = 0 TO NumPars(Level)
  3561.        c = Possible(OperatorNum(FoundOperator(Level)),a,b)
  3562.        d = ParType(Level,b)
  3563.        IF (c AND d) = 0 THEN NotYetFound
  3564.      NEXT b
  3565.      VarianteNum(Level) = a
  3566.      GOTO FoundIt
  3567.    END IF
  3568. NotYetFound:
  3569.  NEXT a
  3570.  CALL SomeError (Func$(OperatorNum(FoundOperator(Level)))+"-function is not possible with these parameters",WordPos(FoundOperator(Level))) : Ergebnis = FALSE : EXIT SUB
  3571. FoundIt:
  3572.  
  3573.  ReturnType(Level) = ResultType(OperatorNum(FoundOperator(Level)),VarianteNum(Level))
  3574.  RETURN
  3575.  
  3576. GetNewLevel:
  3577.  IF NextLevel = MaxLevel+1 THEN CALL SomeError ("Expression to complex",-1) : Ergebnis = FALSE : EXIT SUB
  3578.  NewLevel = NextLevel
  3579.  NextLevel = NextLevel+1
  3580.  RETURN
  3581.  
  3582. AddNewLevelReturnType:
  3583.  OldLevel(NewLevel) = Level
  3584.  Level = NewLevel
  3585.  GOSUB GetReturnType
  3586.  NewLevel = Level
  3587.  Level = OldLevel(NewLevel)
  3588.  NumPars(Level) = NumPars(Level)+1
  3589.  ParType(Level,NumPars(Level)) = ReturnType(NewLevel)
  3590.  CallLevel(Level,NumPars(Level)) = NewLevel
  3591.  RETURN
  3592.  
  3593. DumpCalculation:
  3594.  IF FoundOperator(Level) <> -1 THEN
  3595.    ReadPointer(Level) = 0
  3596.    WHILE ReadPointer(Level) <= NumPars(Level)
  3597.      Level = CallLevel(Level,ReadPointer(Level))
  3598.      GOSUB DumpCalculation
  3599.      Level = OldLevel(Level)
  3600.      Flags1 = ParType(Level,ReadPointer(Level)) AND VarTypeMask
  3601.      Flags2 = MakeTo(OperatorNum(FoundOperator(Level)),VarianteNum(Level),ReadPointer(Level)) AND VarTypeMask
  3602.      CALL TryConv (Flags1,Flags2,WordPos(FoundOperator(Level)))
  3603.      IF Ergebnis = FALSE THEN EXIT SUB
  3604.      ReadPointer(Level) = ReadPointer(Level)+1
  3605.    WEND
  3606.    CALL CallLib (VariantenOffset(OperatorNum(FoundOperator(Level)),VarianteNum(Level)))
  3607.  ELSE
  3608.    IF Von(Level) = Bis(Level) THEN
  3609.      CALL SubDumpVar (Word$(Von(Level)),WordVarFlags(Von(Level)),-1)
  3610.    ELSE
  3611.      ReadPointer(Level) = 0
  3612.      WHILE ReadPointer(Level) <= NumPars(Level)
  3613.        Level = CallLevel(Level,ReadPointer(Level))
  3614.        GOSUB DumpCalculation
  3615.        CALL TryConv (ReturnType(Level),VarINT,WordPos(Von(Level)))
  3616.        IF Ergebnis = FALSE THEN EXIT SUB
  3617.        Level = OldLevel(Level)
  3618.        ReadPointer(Level) = ReadPointer(Level)+1
  3619.      WEND
  3620.      CALL SubIntToString (NumPars(Level))
  3621.      CALL SubDumpVar (Ergebnis$,VarINT+VarCONST,-1)
  3622.      CALL SubDumpSimpleVarPointer (Word$(Von(Level)),WordVarFlags(Von(Level)),NumPars(Level))
  3623.      IF WordVarFlags(Von(Level)) = VarTEXT THEN
  3624.        CALL CallLib (-786)'GETTEXTELEM_FP_T
  3625.      ELSEIF WordVarFlags(Von(Level)) = VarINT THEN
  3626.        CALL CallLib (-750)'GETINTELEM_FP_I
  3627.      ELSEIF WordVarFlags(Von(Level)) = VarLONG THEN
  3628.        CALL CallLib (-762)'GETLONGELEM_FP_L
  3629.      ELSEIF WordVarFlags(Von(Level)) = VarREAL THEN
  3630.        CALL CallLib (-774)'GETREALELEM_FP_R
  3631.      ELSEIF WordVarFlags(Von(Level)) = VarDOUB THEN
  3632.        CALL CallLib (-732)'GETDOUBELEM_FP_D
  3633.      END IF
  3634.    END IF
  3635.  END IF
  3636.  RETURN
  3637.  
  3638. END SUB
  3639.  
  3640. '************************************************************
  3641. '*                                                          *
  3642. '* Versucht, rechts und links Klammern zu entfernen         *
  3643. '*                                                          *
  3644. '************************************************************
  3645.  
  3646. SUB TryRemBrackets (Par1,Par2) STATIC
  3647.  FirstWord = Par1 : LastWord = Par2
  3648.  BLevel = 0
  3649. TryNextPair:
  3650.  IF FirstWord < LastWord THEN
  3651.    IF Word$(FirstWord) = "(" AND Word$(LastWord) = ")" THEN
  3652.      BLevel = BLevel+1
  3653.      FirstWord = FirstWord+1
  3654.      LastWord = LastWord-1
  3655.      GOTO TryNextPair
  3656.    END IF
  3657.  END IF
  3658.  Ergebnis = BLevel
  3659.  SafeLevel = BLevel
  3660.  FOR a = FirstWord TO LastWord
  3661.    IF Word$(a) = "(" THEN
  3662.      BLevel = BLevel+1
  3663.    ELSEIF Word$(a) = ")" THEN
  3664.      BLevel = BLevel-1
  3665.      IF BLevel < Ergebnis THEN Ergebnis = BLevel
  3666.    END IF
  3667.  NEXT a
  3668.  IF SafeLevel <> BLevel THEN Ergebnis = 0
  3669. END SUB
  3670.  
  3671. '************************************************************
  3672. '*                                                          *
  3673. '* Definiert ein Label an dieser Stelle                     *
  3674. '*                                                          *
  3675. '************************************************************
  3676.  
  3677. SUB SubSetLabel (LabelName$) STATIC
  3678.  CALL GetLabelNum (LabelName$,TRUE)
  3679.  IF Ergebnis = -1 THEN
  3680.    Ergebnis = FALSE
  3681.  ELSE
  3682.    IF Pass = 2 THEN
  3683.      LabelOffset&(Ergebnis) = HunkOffset&
  3684.    ELSEIF Pass = 3 THEN
  3685.      IF LabelOffset&(Ergebnis) <> HunkOffset& THEN CALL SomeError ("Internal error: phase error",-1)
  3686.    END IF
  3687.    Ergebnis = TRUE
  3688.  END IF
  3689. END SUB
  3690.  
  3691. '************************************************************
  3692. '*                                                          *
  3693. '* Legt ein Label auf dem Stack ab                          *
  3694. '*                                                          *
  3695. '************************************************************
  3696.  
  3697. SUB SubDumpLabel (LabelName$) STATIC
  3698.  CALL GetLabelNum (LabelName$,FALSE) : LabelNumber = Ergebnis
  3699.  IF Pass > 1 THEN
  3700.    CALL PrintToFile MKI$(18553)        ' pea Wert.l
  3701.    IF Pass = 3 THEN
  3702.      PRINT #3,MKL$(HunkOffset&);
  3703.    END IF
  3704.    CALL PrintToFile MKL$(LabelOffset&(LabelNumber))
  3705.  END IF
  3706. END SUB
  3707.  
  3708. SUB SubDumpOnlyLabel (LabelName$) STATIC
  3709.  CALL GetLabelNum (LabelName$,FALSE) : LabelNumber = Ergebnis
  3710.  IF Pass > 1 THEN
  3711.    IF Pass = 3 THEN
  3712.      PRINT #3,MKL$(HunkOffset&);
  3713.    END IF
  3714.    CALL PrintToFile MKL$(LabelOffset&(LabelNumber))
  3715.  END IF
  3716. END SUB
  3717.  
  3718. '************************************************************
  3719. '*                                                          *
  3720. '* Besorgt die Ablagenummer eines Labels                    *
  3721. '*                                                          *
  3722. '************************************************************
  3723.  
  3724. SUB GetLabelNum (LabelName$,IsDefinition) STATIC
  3725.  FOR a = 0 TO NumLabels
  3726.    IF Label$(a) = LabelName$ THEN LabelFound
  3727.  NEXT a
  3728.  IF NumLabels = MaxLabels THEN PRINT : PRINT "Too many labels - Aborting!" : CALL EndPrg
  3729.  NumLabels = NumLabels+1
  3730.  Label$(NumLabels) = LabelName$
  3731.  LabelLine(NumLabels) = FALSE
  3732.  a = NumLabels
  3733. LabelFound:
  3734.  IF Pass = 1 AND IsDefinition = TRUE AND LabelLine(a) <> FALSE THEN
  3735.    CALL SomeError ("Label "+LabelName$+" is already defined",-1)
  3736.    Ergebnis = -1
  3737.  ELSE
  3738.    IF IsDefinition THEN LabelLine(a) = ThisLine
  3739.    Ergebnis = a
  3740.  END IF
  3741. END SUB
  3742.  
  3743. '************************************************************
  3744. '*                                                          *
  3745. '* Versucht die Konvertierung von einem Typ zu einem anderen*
  3746. '*                                                          *
  3747. '************************************************************
  3748.  
  3749. SUB TryConv (Par1,Flags2,ErrorPos) STATIC
  3750.  Flags1 = Par1 AND VarTypeMask
  3751.  IF Flags1 <> Flags2 THEN
  3752.    FOR a = 0 TO NumConv
  3753.      IF CConvFrom(a) = Flags1 AND CConvTo(a) = Flags2 THEN CALL CallLib (CConvOffset(a)) : Ergebnis = TRUE : EXIT SUB
  3754.    NEXT a
  3755.    CALL SomeError ("Cannot convert from/to TEXT",ErrorPos) : Ergebnis = FALSE : EXIT SUB
  3756.  END IF
  3757.  Ergebnis = TRUE
  3758. END SUB
  3759.  
  3760. '************************************************************
  3761. '*                                                          *
  3762. '* Holt Variablennummer aus der Variablentabelle            *
  3763. '*                                                          *
  3764. '************************************************************
  3765.  
  3766. SUB GetVarNum (Par1$,VarFlags,VarType,VarSubNum) STATIC
  3767.  VarName$ = Par1$
  3768. ' Typzeichen ggf. entfernen
  3769.  IF INSTR(CharTypes$,RIGHT$(VarName$,1)) THEN
  3770.    VarName$ = LEFT$(VarName$,LEN(VarName$)-1)
  3771.  END IF
  3772. ' Variable suchen
  3773.  FOR a = 0 TO NumVars
  3774.    IF VarName$ = VarName$(a) THEN
  3775.      IF VarFlags = VarFlags(a) THEN
  3776.        IF VarSubNum = VarSubNum(a) OR VarSubNum(a) = 0 OR VarSubNum = 0 THEN
  3777.          IF VarType = VarType(a) OR (VarType >= 0 AND VarType(a) >= 0) THEN FoundThisVar
  3778.        END IF
  3779.      END IF
  3780.    END IF
  3781.  NEXT a
  3782.  IF NumVars = MaxVars THEN PRINT : PRINT "Too many variables - Aborting!" : CALL EndPrg
  3783.  NumVars = NumVars+1
  3784.  VarName$(NumVars) = VarName$
  3785.  VarFlags(NumVars) = VarFlags
  3786.  VarType(NumVars) = VarType
  3787.  VarSubNum(NumVars) = VarSubNum
  3788.  a = NumVars
  3789. FoundThisVar:
  3790. ' ggf. Type und SubNum korrigieren
  3791.  IF VarType(a) >= 0 AND VarType > VarType(a) THEN VarType(a) = VarType
  3792.  IF VarSubNum = 0 THEN VarSubNum(a) = 0
  3793.  Ergebnis = a
  3794. END SUB
  3795.  
  3796. '************************************************************
  3797. '*                                                          *
  3798. '* Das Ende einer Variablen suchen                          *
  3799. '*                                                          *
  3800. '************************************************************
  3801.  
  3802. SUB GetVarEnd (Word1,Word2,PrintErrors) STATIC
  3803.  FirstWord = Word1 : LastWord = Word2
  3804.  IF FirstWord > LastWord THEN VarLengthError
  3805.  IF IsVar(FirstWord) = FALSE THEN VarLengthError
  3806.  IF WordVarFlags(FirstWord) AND VarCONST THEN VarLengthError
  3807.  IF FirstWord = LastWord THEN
  3808.    Ergebnis = FirstWord : EXIT SUB
  3809.  ELSE
  3810.    IF Word$(FirstWord+1) = "(" THEN
  3811.      Ergebnis = FirstWord+1
  3812.      BLevel = 1
  3813.      WHILE BLevel <> 0
  3814.        Ergebnis = Ergebnis+1
  3815.        IF Ergebnis > LastWord THEN
  3816.          IF PrintErrors THEN CALL SomeError ("')' missing",WordPos(Ergebnis))
  3817.          Ergebnis = -1 : EXIT SUB
  3818.        END IF
  3819.        IF Word$(Ergebnis) = ")" THEN BLevel = BLevel-1
  3820.        IF Word$(Ergebnis) = "(" THEN BLevel = BLevel+1
  3821.      WEND
  3822.      EXIT SUB
  3823.    ELSE
  3824.      Ergebnis = FirstWord : EXIT SUB
  3825.    END IF
  3826.  END IF
  3827.  
  3828. VarLengthError:
  3829.  IF PrintErrors THEN CALL SomeError ("Expected a variable",WordPos(FirstWord))
  3830.  Ergebnis = -1 : EXIT SUB
  3831. END SUB
  3832.  
  3833. '************************************************************
  3834. '*                                                          *
  3835. '* Zuweisung zu einer Variablen                             *
  3836. '*                                                          *
  3837. '************************************************************
  3838.  
  3839. ' GetVarEnd wurde schon durchgefuehrt
  3840. SUB SubDumpSetVar (Word1,Word2,Par3) STATIC
  3841.  FirstWord = Word1 : LastWord = Word2 : StackFlags = (Par3 AND VarTypeMask)
  3842.  IF WordVarFlags(FirstWord) <> StackFlags THEN
  3843.    CALL TryConv (StackFlags,WordVarFlags(FirstWord),WordPos(FirstWord))
  3844.    IF Ergebnis = FALSE THEN EXIT SUB
  3845.  END IF
  3846.  IF FirstWord = LastWord THEN
  3847.    CALL SubDumpSetSimpleVar (Word$(FirstWord),WordVarFlags(FirstWord),-1)
  3848.  ELSE
  3849.    CALL SubDumpField (FirstWord,LastWord)
  3850.    IF Ergebnis = FALSE THEN EXIT SUB
  3851.    SafeErgebnis = Ergebnis
  3852.    IF Ergebnis = VarTEXT THEN
  3853.      CALL CallLib (-1962)'SETTEXTELEM_TFP_
  3854.    ELSEIF Ergebnis = VarINT THEN
  3855.      CALL CallLib (-1914)'SETINTELEM_IFP_
  3856.    ELSEIF Ergebnis = VarLONG THEN
  3857.      CALL CallLib (-1926)'SETLONGELEM_LFP_
  3858.    ELSEIF Ergebnis = VarREAL THEN
  3859.      CALL CallLib (-1950)'SETREALELEM_RFP_
  3860.    ELSEIF Ergebnis = VarDOUB THEN
  3861.      CALL CallLib (-1908)'SETDOUBELEM_DFP_
  3862.    END IF
  3863.    Ergebnis = SafeErgebnis
  3864.  END IF
  3865. END SUB
  3866.  
  3867. '************************************************************
  3868. '*                                                          *
  3869. '* Zeiger auf eine Variable ausgeben                        *
  3870. '*                                                          *
  3871. '************************************************************
  3872.  
  3873. SUB SubDumpVarPointer (Word1,Word2) STATIC
  3874. ' Vorher wurde GetVarEnd aufgerufen, d.h. die Parameter sind in Ordnung
  3875.  FirstWord = Word1 : LastWord = Word2
  3876.  IF FirstWord = LastWord THEN
  3877.    CALL SubDumpSimpleVarPointer (Word$(FirstWord),WordVarFlags(FirstWord),-1)
  3878.    Ergebnis = WordVarFlags(FirstWord)
  3879.  ELSE
  3880.    CALL SubDumpField (FirstWord,LastWord)
  3881.    IF Ergebnis = FALSE THEN EXIT SUB
  3882.    SafeErgebnis = Ergebnis
  3883.    IF Ergebnis = VarTEXT THEN
  3884.      CALL CallLib (-780)'GETTEXTELEMPOINTER_FP_L
  3885.    ELSEIF Ergebnis = VarINT THEN
  3886.      CALL CallLib (-744)'GETINTELEMPOINTER_FP_L
  3887.    ELSEIF Ergebnis = VarLONG THEN
  3888.      CALL CallLib (-756)'GETLONGELEMPOINTER_FP_L
  3889.    ELSEIF Ergebnis = VarREAL THEN
  3890.      CALL CallLib (-768)'GETREALELEMPOINTER_FP_L
  3891.    ELSEIF Ergebnis = VarDOUB THEN
  3892.      CALL CallLib (-726)'GETDOUBELEMPOINTER_FP_L
  3893.    END IF
  3894.    Ergebnis = SafeErgebnis
  3895.  END IF
  3896. END SUB
  3897.  
  3898. '************************************************************
  3899. '*                                                          *
  3900. '* Ein ganzes Feld ablegen                                  *
  3901. '*                                                          *
  3902. '************************************************************
  3903.  
  3904. ' GetVarEnd wurde schon aufgerufen
  3905. SUB SubDumpField (Par1,Par2) STATIC
  3906.  FirstWord = Par1 : LastWord = Par2
  3907.  FieldNamePointer = FirstWord
  3908. ' F dumpen
  3909.  NumberOfFields = -1
  3910.  FirstWord = FirstWord+2
  3911.  LastWord = LastWord-1
  3912.  ExpectKomma = FALSE
  3913.  WHILE FirstWord <= LastWord OR ExpectKomma = FALSE
  3914.    IF ExpectKomma THEN
  3915.      IF Word$(FirstWord) <> "," THEN CALL SomeError ("Expected ','",WordPos(FirstWord)) : Ergebnis = FALSE : EXIT SUB
  3916.      FirstWord = FirstWord+1
  3917.    ELSE
  3918.      ExpectKomma = TRUE
  3919.    END IF
  3920.    NumberOfFields = NumberOfFields+1
  3921.    CALL GetExprEnd (FirstWord,LastWord)
  3922.    IF Ergebnis = -1 THEN Ergebnis = FALSE : EXIT SUB
  3923.    EndOfExpr = Ergebnis
  3924.    CALL SubDumpExpr (FirstWord,EndOfExpr,VarINT)
  3925.    IF Ergebnis = FALSE THEN EXIT SUB
  3926.    FirstWord = EndOfExpr+1
  3927.  WEND
  3928. ' Anzahl dumpen
  3929.  CALL SubIntToString (NumberOfFields)
  3930.  CALL SubDumpVar (Ergebnis$,VarINT+VarCONST,-1)
  3931. ' P dumpen
  3932.  CALL SubDumpSimpleVarPointer (Word$(FieldNamePointer),WordVarFlags(FieldNamePointer),NumberOfFields)
  3933.  Ergebnis = WordVarFlags(FieldNamePointer)
  3934. END SUB
  3935.  
  3936. '************************************************************
  3937. '*                                                          *
  3938. '* Zeiger auf Variable auf dem Stack ablegen                *
  3939. '*                                                          *
  3940. '************************************************************
  3941.  
  3942. SUB SubDumpSimpleVarPointer (VarName$,VarFlags,VarType) STATIC
  3943.  CALL GetVarNum (VarName$,VarFlags,VarType,SubNumber) : VarNumber = Ergebnis
  3944.  IF Pass > 1 THEN
  3945.    IF VarSubNum(VarNumber) <> 0 THEN
  3946.      CALL PrintToFile MKI$(18540)      ' pea Offset(a4)
  3947.    ELSE
  3948.      CALL PrintToFile MKI$(18541)      ' pea Offset(a5)
  3949.    END IF
  3950.    CALL PrintToFile MKI$(VarOffset(VarNumber))
  3951.  END IF
  3952. END SUB
  3953.  
  3954. '************************************************************
  3955. '*                                                          *
  3956. '* Variable auf dem Stack ablegen                           *
  3957. '*                                                          *
  3958. '************************************************************
  3959.  
  3960. SUB SubDumpVar (VarName$,VarFlags,VarType) STATIC
  3961.  IF VarFlags AND VarCONST THEN
  3962.    IF VarFlags AND VarTEXT THEN
  3963.      CALL SubGetStringOffset (RIGHT$(VarName$,LEN(VarName$)-1)) : StringOffset = Ergebnis
  3964.      IF Pass > 1 THEN
  3965.        CALL PrintToFile MKI$(18541)    ' pea Offset(a5)
  3966.        CALL PrintToFile MKI$(StringOffset)
  3967.      END IF
  3968.    ELSEIF VarFlags AND VarINT  THEN
  3969.      IF Pass > 1 THEN
  3970.        CALL PrintToFile MKI$(16188)    ' move.w #Wert,-(sp)
  3971.        CALL PrintToFile MKI$(VAL(VarName$))
  3972.      END IF
  3973.    ELSEIF VarFlags AND VarLONG THEN
  3974.      IF Pass > 1 THEN
  3975.        CALL PrintToFile MKI$(18553)    ' pea Wert.l
  3976.        CALL PrintToFile MKL$(VAL(VarName$))
  3977.      END IF
  3978.    ELSEIF VarFlags AND VarREAL THEN
  3979.      IF Pass > 1 THEN
  3980.        CALL PrintToFile MKI$(18553)    ' pea Wert.l
  3981.        CALL PrintToFile MKS$(VAL(VarName$))
  3982.      END IF
  3983.    ELSEIF VarFlags AND VarDOUB THEN
  3984.      IF Pass > 1 THEN
  3985.        CALL PrintToFile MKI$(18553)    ' pea Wert.l
  3986.        CALL PrintToFile RIGHT$(MKD$(VAL(VarName$)),4)
  3987.        CALL PrintToFile MKI$(18553)    ' pea Wert.l
  3988.        CALL PrintToFile LEFT$(MKD$(VAL(VarName$)),4)
  3989.      END IF
  3990.    END IF
  3991.  ELSE
  3992.    CALL GetVarNum (VarName$,VarFlags,VarType,SubNumber) : VarNumber = Ergebnis
  3993.    IF Pass > 1 THEN
  3994.      IF VarFlags AND VarTEXT THEN
  3995.        IF VarSubNum(VarNumber) <> 0 THEN
  3996.          CALL PrintToFile MKI$(18540)  ' pea Offset(a4)
  3997.        ELSE
  3998.          CALL PrintToFile MKI$(18541)  ' pea Offset(a5)
  3999.        END IF
  4000.        CALL PrintToFile MKI$(VarOffset(VarNumber))
  4001.      ELSEIF VarFlags AND VarINT  THEN
  4002.        IF VarSubNum(VarNumber) <> 0 THEN
  4003.          CALL PrintToFile MKI$(16172)  ' move.w Offset(a4),-(sp)
  4004.        ELSE
  4005.          CALL PrintToFile MKI$(16173)  ' move.w Offset(a5),-(sp)
  4006.        END IF
  4007.        CALL PrintToFile MKI$(VarOffset(VarNumber))
  4008.      ELSEIF VarFlags AND VarLONG THEN
  4009.        IF VarSubNum(VarNumber) <> 0 THEN
  4010.          CALL PrintToFile MKI$(12076)  ' move.l Offset(a4),-(sp)
  4011.        ELSE
  4012.          CALL PrintToFile MKI$(12077)  ' move.l Offset(a5),-(sp)
  4013.        END IF
  4014.        CALL PrintToFile MKI$(VarOffset(VarNumber))
  4015.      ELSEIF VarFlags AND VarREAL THEN
  4016.        IF VarSubNum(VarNumber) <> 0 THEN
  4017.          CALL PrintToFile MKI$(12076)  ' move.l Offset(a4),-(sp)
  4018.        ELSE
  4019.          CALL PrintToFile MKI$(12077)  ' move.l Offset(a5),-(sp)
  4020.        END IF
  4021.        CALL PrintToFile MKI$(VarOffset(VarNumber))
  4022.      ELSEIF VarFlags AND VarDOUB THEN
  4023.        IF VarSubNum(VarNumber) <> 0 THEN
  4024.          CALL PrintToFile MKI$(19692)  ' movem.l Offset(a4),RegList
  4025.        ELSE
  4026.          CALL PrintToFile MKI$(19693)  ' movem.l Offset(a5),RegList
  4027.        END IF
  4028.        CALL PrintToFile MKI$(3)        ' d0/d1 Muß zuerst kommen
  4029.        CALL PrintToFile MKI$(VarOffset(VarNumber))
  4030.        CALL PrintToFile MKI$(12033)    ' move.l d1,-(sp)
  4031.        CALL PrintToFile MKI$(12032)    ' move.l d0,-(sp)
  4032.      END IF
  4033.    END IF
  4034.  END IF
  4035. END SUB
  4036.  
  4037. '************************************************************
  4038. '*                                                          *
  4039. '* Variable auf dem Stack ablegen                           *
  4040. '*                                                          *
  4041. '************************************************************
  4042.  
  4043. ' VarName$ darf keine Konstante sein
  4044. SUB SubDumpSetSimpleVar (VarName$,VarFlags,VarType) STATIC
  4045.  CALL GetVarNum (VarName$,VarFlags,VarType,SubNumber) : VarNumber = Ergebnis
  4046.  IF Pass > 1 THEN
  4047.    IF VarFlags = VarTEXT THEN
  4048.      CALL PrintToFile MKI$(8287)       ' move.l (sp)+,a0
  4049.      IF VarSubNum(VarNumber) <> 0 THEN
  4050.        CALL PrintToFile MKI$(10576)    ' move.l (a0),Offset(a4)
  4051.      ELSE
  4052.        CALL PrintToFile MKI$(11088)    ' move.l (a0),Offset(a5)
  4053.      END IF
  4054.      CALL PrintToFile MKI$(VarOffset(VarNumber))
  4055.    ELSEIF VarFlags = VarINT  THEN
  4056.      IF VarSubNum(VarNumber) <> 0 THEN
  4057.        CALL PrintToFile MKI$(14687)    ' move.w (sp)+,Offset(a4)
  4058.      ELSE
  4059.        CALL PrintToFile MKI$(15199)    ' move.w (sp)+,Offset(a5)
  4060.      END IF
  4061.      CALL PrintToFile MKI$(VarOffset(VarNumber))
  4062.    ELSEIF VarFlags = VarLONG THEN
  4063.      IF VarSubNum(VarNumber) <> 0 THEN
  4064.        CALL PrintToFile MKI$(10591)    ' move.w (sp)+,Offset(a4)
  4065.      ELSE
  4066.        CALL PrintToFile MKI$(11103)    ' move.w (sp)+,Offset(a5)
  4067.      END IF
  4068.      CALL PrintToFile MKI$(VarOffset(VarNumber))
  4069.    ELSEIF VarFlags = VarREAL THEN
  4070.      IF VarSubNum(VarNumber) <> 0 THEN
  4071.        CALL PrintToFile MKI$(10591)    ' move.w (sp)+,Offset(a4)
  4072.      ELSE
  4073.        CALL PrintToFile MKI$(11103)    ' move.w (sp)+,Offset(a5)
  4074.      END IF
  4075.      CALL PrintToFile MKI$(VarOffset(VarNumber))
  4076.    ELSEIF VarFlags = VarDOUB THEN
  4077.      CALL PrintToFile MKI$(8223)       ' move.l (sp)+,d0
  4078.      CALL PrintToFile MKI$(8735)       ' move.l (sp)+,d1
  4079.      IF VarSubNum(VarNumber) <> 0 THEN
  4080.        CALL PrintToFile MKI$(18668)    ' movem.l RegList,Offset(a4)
  4081.      ELSE
  4082.        CALL PrintToFile MKI$(18669)    ' movem.l RegList,Offset(a5)
  4083.      END IF
  4084.      CALL PrintToFile MKI$(3)          ' d0/d1
  4085.      CALL PrintToFile MKI$(VarOffset(VarNumber))
  4086.    END IF
  4087.  END IF
  4088.  Ergebnis = TRUE
  4089. END SUB
  4090.  
  4091. '************************************************************
  4092. '*                                                          *
  4093. '* Libraryaufruf                                            *
  4094. '*                                                          *
  4095. '************************************************************
  4096.  
  4097. SUB CallLib (FuncOffset) STATIC
  4098.  IF FuncOffset <> 0 THEN
  4099.    IF Pass > 1 THEN
  4100.      CALL PrintToFile MKI$(20142)     ' jsr Offset(a6)
  4101.      CALL PrintToFile MKI$(FuncOffset)
  4102.    END IF
  4103.  END IF
  4104. END SUB
  4105.  
  4106. '************************************************************
  4107. '*                                                          *
  4108. '* String in Ausgabefile schreiben                          *
  4109. '*                                                          *
  4110. '************************************************************
  4111.  
  4112. SUB PrintToFile (PrintVar$) STATIC
  4113.  IF Pass = 3 THEN
  4114.    PRINT #2,PrintVar$;
  4115.  END IF
  4116.  HunkOffset& = HunkOffset&+LEN(PrintVar$)
  4117. END SUB
  4118.  
  4119. '************************************************************
  4120. '*                                                          *
  4121. '* Stringnummer zurueckgeben                                *
  4122. '*                                                          *
  4123. '************************************************************
  4124.  
  4125. SUB SubGetStringOffset (SConst$) STATIC
  4126.  Von = 0 : Bis = NumStrings+1
  4127.  WHILE Von < Bis
  4128.    Mitte = (Von+Bis)\2
  4129.    IF SConst$ > SString$(Mitte) THEN
  4130.      Von = Mitte+1
  4131.    ELSE
  4132.      Bis = Mitte
  4133.    END IF
  4134.  WEND
  4135.  IF Von <= NumStrings THEN
  4136.    AddNewOne = SString$(Von) <> SConst$
  4137.  ELSE
  4138.    AddNewOne = TRUE
  4139.  END IF
  4140.  IF AddNewOne THEN
  4141.    IF NumStrings = MaxStrings THEN PRINT : PRINT "Too many strings - Aborting!" : CALL EndPrg
  4142.    FOR a = NumStrings TO Von STEP -1
  4143.      SString$(a+1) = SString$(a)
  4144.    NEXT a
  4145.    NumStrings = NumStrings+1
  4146.    SString$(Von) = SConst$
  4147.  END IF
  4148.  IF Pass > 1 THEN
  4149.    Ergebnis = 0-StringBase-NumStrings*4-4+Von*4
  4150.  ELSE
  4151.    Ergebnis = FALSE
  4152.  END IF
  4153. END SUB
  4154.  
  4155. '************************************************************
  4156. '*                                                          *
  4157. '* Fuehrendes Leerzeichen entfernen                         *
  4158. '*                                                          *
  4159. '************************************************************
  4160.  
  4161. SUB SubIntToString (IntNum) STATIC
  4162.  Ergebnis$ = STR$(IntNum)
  4163.  IF IntNum >= 0 THEN
  4164.    Ergebnis$ = RIGHT$(Ergebnis$,LEN(Ergebnis$)-1)
  4165.  END IF
  4166. END SUB
  4167.  
  4168. '************************************************************
  4169. '*                                                          *
  4170. '* Einen Data-String ablegen                                *
  4171. '*                                                          *
  4172. '************************************************************
  4173.  
  4174. SUB AddData (ToAdd$) STATIC
  4175.  IF Pass = 1 THEN
  4176.    CALL SubGetStringOffset (ToAdd$)
  4177.    IF NumData = MaxData THEN PRINT : PRINT "Too many DATAs. Aborting!" : CALL EndPrg
  4178.    NumData = NumData+1
  4179.    DataLine(NumData) = ThisLine
  4180.  END IF
  4181.  IF Pass = 2 THEN
  4182.    CALL SubGetStringOffset (ToAdd$)
  4183.    NumDataPass2 = NumDataPass2+1
  4184.    DataStringOffset(NumDataPass2) = Ergebnis
  4185.  END IF
  4186.  Ergebnis = TRUE
  4187. END SUB
  4188.  
  4189. '************************************************************
  4190. '*                                                          *
  4191. '* Besorgt die Nummer eines Unterprogramms                  *
  4192. '*                                                          *
  4193. '************************************************************
  4194.  
  4195. SUB GetMySubNum (SubName$,IsDefinition) STATIC
  4196.  FOR a = 0 TO NumSubs
  4197.    IF SubName$ = SubName$(a) THEN FoundMySub
  4198.  NEXT a
  4199.  IF NumSubs = MaxSubs THEN PRINT : PRINT "Too many subprograms - Aborting!" : CALL EndPrg
  4200.  NumSubs = NumSubs+1
  4201.  SubName$(NumSubs) = SubName$
  4202.  NumSubPars(NumSubs) = -1
  4203.  IsSubDef(NumSubs) = FALSE
  4204.  a = NumSubs
  4205. FoundMySub:
  4206.  IF IsDefinition THEN
  4207.    IF IsSubDef(NumSubs) AND Pass = 1 THEN
  4208.      CALL SomeError ("Subprogram is already defined",-1)
  4209.    ELSE
  4210.      IsSubDef(NumSubs) = TRUE
  4211.    END IF
  4212.  ELSE
  4213.    IF IsSubDef(NumSubs) = FALSE AND Pass > 1 THEN CALL SomeError ("Subprogram ist not defined",-1) : Ergebnis = -1 : EXIT SUB
  4214.  END IF
  4215.  Ergebnis = a
  4216. END SUB
  4217.  
  4218. '************************************************************
  4219. '*                                                          *
  4220. '* Programm beenden                                         *
  4221. '*                                                          *
  4222. '************************************************************
  4223.  
  4224. SUB EndPrg STATIC
  4225.  BEEP
  4226.  PRINT
  4227.  PRINT "Press any key..."
  4228.  WHILE INKEY$ = ""
  4229.  WEND
  4230.  END
  4231. END SUB
  4232.  
  4233.